Always queue updates in reactions, even when flushing

This commit is contained in:
Dan Holmsand 2015-10-07 11:32:42 +02:00
parent e6b32c6aee
commit e79132c1f3
6 changed files with 45 additions and 53 deletions

View File

@ -88,4 +88,5 @@
(.schedule render-queue))
(defn schedule []
(.schedule render-queue))
(when (false? (.-scheduled? render-queue))
(.schedule render-queue)))

View File

@ -52,8 +52,8 @@
(when-some [r *ratom-context*]
(let [c (.-captured r)]
(if (nil? c)
(set! (.-captured r) (array derefed))
(.push c derefed)))))
(set! (.-captured r) (array derefed))
(.push c derefed)))))
(defn- check-watches [old new]
(when debug
@ -94,7 +94,6 @@
;;; Queueing
(defonce ^:private rea-queue nil)
(def ^:private empty-context #js{})
(defn- rea-enqueue [r]
(when (nil? rea-queue)
@ -102,16 +101,14 @@
(batch/schedule))
(.push rea-queue r))
(defn- run-queue [q]
(set! rea-queue nil)
(dotimes [i (alength q)]
(let [r (aget q i)]
(._try-run r))))
(defn flush! []
(when-some [q rea-queue]
(binding [*ratom-context* empty-context]
(run-queue q))))
(loop []
(let [q rea-queue]
(when-not (nil? q)
(set! rea-queue nil)
(dotimes [i (alength q)]
(._try-run (aget q i)))
(recur)))))
(set! batch/ratom-flush flush!)
@ -375,15 +372,12 @@
(-deref this)))
(_handle-change [this sender oldval newval]
(when-not (identical? oldval newval)
(if (nil? *ratom-context*)
(do (set! dirty? true)
(rea-enqueue this))
(if (nil? auto-run)
(when-not dirty?
(set! dirty? true)
(._run this))
(auto-run this)))))
(when-not (or (identical? oldval newval)
dirty?)
(set! dirty? true)
(if (nil? auto-run)
(rea-enqueue this)
(auto-run this))))
(_update-watching [this derefed]
(let [new (set derefed)
@ -395,16 +389,14 @@
(-remove-watch w this))))
(_try-run [this other]
(if (some? auto-run)
(auto-run this)
(when (and dirty? (some? watching))
(try
(._run this)
(catch :default e
;; Just log error: it will most likely pop up again at deref time.
(error "Error in reaction:" e)
(set! state nil)
(notify-w this e nil))))))
(when (and dirty? (some? watching))
(try
(._run this)
(catch :default e
;; Just log error: it will most likely pop up again at deref time.
(error "Error in reaction:" e)
(set! state nil)
(notify-w this e nil)))))
(_run [this]
(let [oldstate state
@ -567,13 +559,13 @@
(let [nite 100000
a (atom 0)
f (fn []
;; (ratom/with-let [x 1])
(quot @a 10))
mid (make-reaction f)
res (track! (fn []
;; @(ratom/track f)
;; (with-let [x 1])
;; @(track f)
(inc @mid)
))]
))]
@res
(time (dotimes [x nite]
(swap! a inc)

View File

@ -41,7 +41,7 @@
(reset! start 1)
(r/flush)
(is (= @out 3))
(is (= @count 4))
(is (<= 2 @count 3))
(dispose const)
(is (= @start-base {:a {:b {:c 1}}}))
(is (= (running) runs))))

View File

@ -24,17 +24,16 @@
(defn ratom-perf []
(dbg "ratom-perf")
(set! rv/debug false)
(set! perf-check 0)
(let [nite 100000
a (rv/atom 0)
mid (reaction (inc @a))
res (run!
(set! perf-check (inc perf-check))
(inc @mid))]
(time (dotimes [x nite]
(swap! a inc)))
(dispose res)
(assert (= perf-check (inc nite)))))
(dotimes [_ 10]
(let [nite 100000
a (rv/atom 0)
mid (reaction (quot @a 10))
res (run!
(inc @mid))]
(time (dotimes [x nite]
(swap! a inc)
(rv/flush!)))
(dispose res))))
(enable-console-print!)
;; (ratom-perf)
@ -57,7 +56,7 @@
(reset! start 1)
(r/flush)
(is (= @out 3))
(is (= @count 4))
(is (<= 2 @count 3))
(dispose const)
(is (= (running) runs))))

View File

@ -43,7 +43,7 @@
(is (= @count 1))
(sync)
(is (= @out 3))
(is (= @count 4))
(is (<= 2 @count 3))
(reset! start 2)
(dispose const)
(is (= (running) runs) "did dispose")

View File

@ -47,7 +47,7 @@
(reset! start 1)
(r/flush)
(is (= @out 8))
(is (= @count 4))
(is (<= 2 @count 3))
(dispose const)
(is (= (running) runs))))
@ -74,13 +74,13 @@
(is (= @count 1))
(sync)
(is (= @out 8))
(is (= @count 4))
(is (<= 2 @count 3))
(dispose const)
(swap! start inc)
(sync)
(is (= @count 4))
(is (<= 2 @count 3))
(is (= @const 11))
(is (= @count 5))
(is (<= 3 @count 4))
(is (= (running) runs))))
(deftest double-dependency