├── ORIGINATOR ├── .github └── CODEOWNERS ├── doc ├── manifold.png ├── cljdoc.edn ├── rationale.md ├── execution.md ├── deferred.md └── stream.md ├── .clj-kondo └── config.edn ├── .gitignore ├── test └── manifold │ ├── test_utils.clj │ ├── bus_test.clj │ ├── time_test.clj │ ├── executor_test.clj │ ├── go_off_test.clj │ ├── deferred_test.clj │ ├── stream_test.clj │ └── deferred_stage_test.clj ├── resources └── clj-kondo.exports │ └── manifold │ └── manifold │ ├── config.edn │ └── manifold │ └── hooks.clj ├── .circleci └── config.yml ├── src └── manifold │ ├── debug.clj │ ├── stream │ ├── random_access.clj │ ├── deferred.clj │ ├── iterator.clj │ ├── seq.clj │ ├── queue.clj │ ├── async.clj │ ├── core.clj │ ├── default.clj │ └── graph.clj │ ├── test.clj │ ├── utils.clj │ ├── bus.clj │ ├── go_off.clj │ ├── time.clj │ └── executor.clj ├── project.clj ├── README.md └── CHANGES.md /ORIGINATOR: -------------------------------------------------------------------------------- 1 | @ztellman 2 | -------------------------------------------------------------------------------- /.github/CODEOWNERS: -------------------------------------------------------------------------------- 1 | * @DerGuteMoritz 2 | -------------------------------------------------------------------------------- /doc/manifold.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clj-commons/manifold/HEAD/doc/manifold.png -------------------------------------------------------------------------------- /.clj-kondo/config.edn: -------------------------------------------------------------------------------- 1 | {:config-paths ["../resources/clj-kondo.exports/manifold/manifold/"]} 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-port 10 | *DS_Store 11 | push 12 | /.clj-kondo/.cache 13 | /.clj-kondo/manifold/manifold 14 | /.clj-kondo/potemkin 15 | /.lsp 16 | /.portal 17 | -------------------------------------------------------------------------------- /doc/cljdoc.edn: -------------------------------------------------------------------------------- 1 | {:cljdoc.doc/tree [["Read Me" {:file "README.md"}] 2 | ["Rationale" {:file "doc/rationale.md"}] 3 | ["Deferreds" {:file "doc/deferred.md"}] 4 | ["Streams" {:file "doc/stream.md"}] 5 | ["Execution" {:file "doc/execution.md"}]]} -------------------------------------------------------------------------------- /test/manifold/test_utils.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.test-utils 2 | (:require 3 | [clojure.test :as test] 4 | [criterium.core :as c] 5 | [manifold.debug :as debug])) 6 | 7 | (defmacro long-bench [name & body] 8 | `(do 9 | (println "\n-----\n" ~name "\n-----\n") 10 | (c/bench 11 | (do ~@body) 12 | :reduce-with #(and %1 %2)))) 13 | 14 | (defmacro bench [name & body] 15 | `(do 16 | (println "\n-----\n" ~name "\n-----\n") 17 | (c/quick-bench 18 | (do ~@body) 19 | :reduce-with #(and %1 %2)))) 20 | -------------------------------------------------------------------------------- /test/manifold/bus_test.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.bus-test 2 | (:require 3 | [clojure.test :refer :all] 4 | [manifold.test :refer :all] 5 | [manifold.stream :as s] 6 | [manifold.deferred :as d] 7 | [manifold.bus :as b])) 8 | 9 | (deftest test-bus 10 | (let [b (b/event-bus)] 11 | (is (= false @(b/publish! b :foo 1))) 12 | (is (= false @(b/publish! b :bar 2))) 13 | (let [s (b/subscribe b :foo) 14 | d (b/publish! b :foo 2)] 15 | (is (= 2 @(s/take! s))) 16 | (is (= true @d)) 17 | (s/close! s) 18 | (is (= false @(b/publish! b :foo 2)))))) 19 | 20 | (deftest test-topic-equality 21 | (let [b (b/event-bus) 22 | s (b/subscribe b (int 1)) 23 | d (b/publish! b (long 1) 42)] 24 | (is (= 42 @(s/take! s))) 25 | (is (= true @d)))) 26 | 27 | (instrument-tests-with-dropped-error-detection!) 28 | -------------------------------------------------------------------------------- /resources/clj-kondo.exports/manifold/manifold/config.edn: -------------------------------------------------------------------------------- 1 | {:lint-as {manifold.deferred/let-flow clojure.core/let 2 | manifold.deferred/let-flow' clojure.core/let 3 | ;; aliasing loop to let is enough to get 4 | ;; great linting. 5 | manifold.deferred/loop clojure.core/let 6 | manifold.utils/definterface+ clojure.core/definterface} 7 | 8 | :hooks {:analyze-call 9 | {manifold.stream.core/def-source manifold.hooks/def-sink-or-source 10 | manifold.stream.core/def-sink manifold.hooks/def-sink-or-source 11 | manifold.stream.core/def-sink+source manifold.hooks/def-sink-or-source 12 | manifold.deferred/both manifold.hooks/both 13 | manifold.deferred/success-error-unrealized manifold.hooks/success-error-unrealized}} 14 | 15 | :config-in-call {manifold.stream.core/def-sink+source 16 | {:linters {:redefined-var {:level :off}}} 17 | 18 | manifold.stream.core/def-sink 19 | {:linters {:redefined-var {:level :off}}} 20 | 21 | manifold.stream.core/def-source 22 | {:linters {:redefined-var {:level :off}}}}} 23 | -------------------------------------------------------------------------------- /.circleci/config.yml: -------------------------------------------------------------------------------- 1 | # Clojure CircleCI 2.0 configuration file 2 | # 3 | # Check https://circleci.com/docs/2.0/language-clojure/ for more details 4 | # 5 | version: 2 6 | jobs: 7 | build: 8 | docker: 9 | # specify the version you desire here 10 | - image: cimg/clojure:1.11.1-openjdk-8.0 11 | 12 | # Specify service dependencies here if necessary 13 | # CircleCI maintains a library of pre-built images 14 | # documented at https://circleci.com/docs/2.0/circleci-images/ 15 | # - image: circleci/postgres:9.4 16 | 17 | working_directory: ~/repo 18 | 19 | environment: 20 | LEIN_ROOT: "true" 21 | # Customize the JVM maximum heap limit 22 | JVM_OPTS: -Xmx3200m 23 | 24 | steps: 25 | - checkout 26 | 27 | # Download and cache dependencies 28 | - restore_cache: 29 | keys: 30 | - v1-dependencies-{{ checksum "project.clj" }} 31 | # fallback to using the latest cache if no exact match is found 32 | - v1-dependencies- 33 | 34 | - run: lein deps 35 | 36 | - save_cache: 37 | paths: 38 | - ~/.m2 39 | key: v1-dependencies-{{ checksum "project.clj" }} 40 | 41 | # run tests! 42 | - run: lein do clean, test 43 | - run: lein with-profile +older-core-async do clean, test manifold.go-off-test -------------------------------------------------------------------------------- /src/manifold/debug.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.debug 2 | {:no-doc true} 3 | (:require [clojure.tools.logging :as log])) 4 | 5 | (def ^:dynamic *dropped-error-logging-enabled?* true) 6 | 7 | (defn enable-dropped-error-logging! [] 8 | (.bindRoot #'*dropped-error-logging-enabled?* true)) 9 | 10 | (defn disable-dropped-error-logging! [] 11 | (.bindRoot #'*dropped-error-logging-enabled?* false)) 12 | 13 | (def ^:dynamic *leak-aware-deferred-rate* 1024) 14 | 15 | (defn set-leak-aware-deferred-rate! [n] 16 | (.bindRoot #'*leak-aware-deferred-rate* n)) 17 | 18 | (def dropped-errors nil) 19 | 20 | (defn log-dropped-error! [error] 21 | (some-> dropped-errors (swap! inc)) 22 | (log/warn error "unconsumed deferred in error state, make sure you're using `catch`.")) 23 | 24 | (defn with-dropped-error-detection 25 | "Calls f, then attempts to trigger dropped errors to be detected and finally calls 26 | handle-dropped-errors with the number of detected dropped errors. Details about these are logged 27 | as warnings." 28 | [f handle-dropped-errors] 29 | (assert (nil? dropped-errors) "with-dropped-error-detection may not be nested") 30 | ;; Flush out any pending dropped errors from before 31 | (System/gc) 32 | (System/runFinalization) 33 | (with-redefs [dropped-errors (atom 0)] 34 | (f) 35 | ;; Flush out any errors which were dropped during f 36 | (System/gc) 37 | (System/runFinalization) 38 | (handle-dropped-errors @dropped-errors))) 39 | -------------------------------------------------------------------------------- /src/manifold/stream/random_access.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.stream.random-access 2 | {:no-doc true} 3 | (:require 4 | [clojure.tools.logging :as log] 5 | [clj-commons.primitive-math :as p] 6 | [manifold.deferred :as d] 7 | [manifold.utils :as utils] 8 | [manifold.stream 9 | [core :as s] 10 | [graph :as g]] 11 | [manifold.time :as time]) 12 | (:import 13 | [java.util 14 | RandomAccess 15 | List] 16 | [java.util.concurrent.atomic 17 | AtomicLong])) 18 | 19 | (set! *unchecked-math* true) 20 | 21 | (s/def-source RandomAccessSource 22 | [^List list 23 | ^AtomicLong idx 24 | ^long size] 25 | 26 | (isSynchronous [_] 27 | true) 28 | 29 | (close [_] 30 | (.set idx size)) 31 | 32 | (description [this] 33 | {:type "random-access-list" 34 | :drained? (s/drained? this)}) 35 | 36 | (take [this default-val blocking?] 37 | 38 | (let [idx' (.getAndIncrement idx)] 39 | (if (p/< idx' size) 40 | (let [val (.get list idx')] 41 | (if blocking? 42 | val 43 | (d/success-deferred val))) 44 | (do 45 | (.markDrained this) 46 | (if blocking? 47 | default-val 48 | (d/success-deferred default-val)))))) 49 | 50 | (take [this default-val blocking? timeout timeout-val] 51 | (.take this default-val blocking?))) 52 | 53 | (extend-protocol s/Sourceable 54 | 55 | java.util.RandomAccess 56 | (to-source [list] 57 | (->RandomAccessSource 58 | list 59 | (AtomicLong. 0) 60 | (.size ^List list)))) 61 | -------------------------------------------------------------------------------- /src/manifold/stream/deferred.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.stream.deferred 2 | {:no-doc true} 3 | (:require 4 | [manifold.deferred :as d] 5 | [manifold.stream.core :as s] 6 | manifold.stream.graph) 7 | (:import 8 | [manifold.deferred 9 | IDeferred] 10 | [java.util.concurrent.atomic 11 | AtomicReference] 12 | [clojure.lang 13 | IPending] 14 | [java.util.concurrent 15 | Future])) 16 | 17 | (s/def-sink DeferredSink 18 | [d] 19 | 20 | (isSynchronous [_] 21 | false) 22 | 23 | (description [_] 24 | {:type "deferred"}) 25 | 26 | (put [this x blocking?] 27 | (if (d/success! d x) 28 | (do 29 | (.markClosed this) 30 | (if blocking? 31 | true 32 | (d/success-deferred true))) 33 | (do 34 | (.markClosed this) 35 | (if blocking? 36 | false 37 | (d/success-deferred false))))) 38 | 39 | (put [this x blocking? timeout timeout-val] 40 | (.put this x blocking?))) 41 | 42 | (s/def-source DeferredSource 43 | [^AtomicReference d] 44 | 45 | (isSynchronous [_] 46 | false) 47 | 48 | (description [_] 49 | {:type "deferred"}) 50 | 51 | (take [this default-val blocking?] 52 | (let [d (.getAndSet d ::none)] 53 | (if (identical? ::none d) 54 | (if blocking? 55 | default-val 56 | (d/success-deferred default-val)) 57 | (do 58 | (.markDrained this) 59 | (if blocking? 60 | @d 61 | d))))) 62 | 63 | (take [this default-val blocking? timeout timeout-val] 64 | (let [d (.take this false ::none)] 65 | (if (identical? d ::none) 66 | (if blocking? 67 | default-val 68 | (d/success-deferred default-val)) 69 | (do 70 | (.markDrained this) 71 | (let [d' (d/deferred)] 72 | (d/connect d d') 73 | (d/timeout! d' timeout timeout-val))))))) 74 | 75 | (extend-protocol s/Sourceable 76 | 77 | IDeferred 78 | (to-source [d] 79 | (->DeferredSource 80 | (AtomicReference. d)))) 81 | 82 | (extend-protocol s/Sinkable 83 | 84 | IDeferred 85 | (to-sink [d] 86 | (->DeferredSink d))) 87 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject manifold "0.4.4" 2 | :description "A compatibility layer for event-driven abstractions" 3 | :license {:name "MIT License" 4 | :url "http://opensource.org/licenses/MIT"} 5 | :url "https://github.com/clj-commons/manifold" 6 | :scm {:name "git" :url "https://github.com/clj-commons/manifold"} 7 | :dependencies [[org.clojure/clojure "1.11.1" :scope "provided"] 8 | [org.clojure/tools.logging "1.2.4" :exclusions [org.clojure/clojure]] 9 | [org.clj-commons/dirigiste "1.0.4"] 10 | [org.clj-commons/primitive-math "1.0.0"] 11 | [riddley "0.2.0"] 12 | [org.clojure/core.async "1.6.673" :scope "provided"] 13 | [potemkin "0.4.6"]] 14 | :profiles {:dev {:dependencies [[criterium "0.4.6"]] 15 | :global-vars {*warn-on-reflection* true 16 | *unchecked-math* :warn-on-boxed}} 17 | ;; core.async moved around some internal functions go-off relies on; this profile 18 | ;; helps test that go-off still works both with the new namespaces and the old 19 | :older-core-async {:dependencies [[org.clojure/core.async "1.5.648" :scope "provided"]]}} 20 | :test-selectors {:default #(not 21 | (some #{:benchmark :stress} 22 | (cons (:tag %) (keys %)))) 23 | :benchmark :benchmark 24 | :stress #(or (:stress %) (= :stress (:tag %))) 25 | :all (constantly true)} 26 | :global-vars {*warn-on-reflection* true} 27 | :jvm-opts ^:replace ["-server" 28 | "-XX:-OmitStackTraceInFastThrow" 29 | "-Xmx2g" 30 | "-XX:NewSize=1g"] 31 | :javac-options ["-target" "1.8" "-source" "1.8"] 32 | 33 | :pom-addition ([:organization 34 | [:name "CLJ Commons"] 35 | [:url "http://clj-commons.org/"]] 36 | [:developers [:developer 37 | [:id "kingmob"] 38 | [:name "Matthew Davidson"] 39 | [:url "http://modulolotus.net"] 40 | [:email "matthew@modulolotus.net"]]])) 41 | -------------------------------------------------------------------------------- /src/manifold/stream/iterator.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.stream.iterator 2 | {:no-doc true} 3 | (:require 4 | [clojure.tools.logging :as log] 5 | [manifold.deferred :as d] 6 | [manifold.utils :as utils] 7 | [manifold.stream 8 | [core :as s] 9 | [graph :as g]] 10 | [manifold.time :as time]) 11 | (:import 12 | [java.util 13 | Iterator] 14 | [java.util.concurrent.atomic 15 | AtomicReference] 16 | (java.util.stream BaseStream))) 17 | 18 | (s/def-source IteratorSource 19 | [^Iterator iterator 20 | ^AtomicReference last-take] 21 | 22 | (isSynchronous [_] 23 | true) 24 | 25 | (close [_] 26 | (if (instance? java.io.Closeable iterator) 27 | (.close ^java.io.Closeable iterator))) 28 | 29 | (description [this] 30 | {:type "iterator" 31 | :drained? (s/drained? this)}) 32 | 33 | (take [this default-val blocking?] 34 | (if blocking? 35 | 36 | (if (.hasNext iterator) 37 | (.next iterator) 38 | (do 39 | (.markDrained this) 40 | default-val)) 41 | 42 | (let [d (d/deferred) 43 | d' (.getAndSet last-take d) 44 | f (fn [_] 45 | (utils/wait-for 46 | (when-let [token (d/claim! d)] 47 | (if (.hasNext iterator) 48 | (d/success! d (.next iterator) token) 49 | (do 50 | (.markDrained this) 51 | (d/success! d default-val token))))))] 52 | (if (d/realized? d') 53 | (f nil) 54 | (d/on-realized d' f f)) 55 | d))) 56 | 57 | (take [this default-val blocking? timeout timeout-val] 58 | (if (nil? timeout) 59 | (.take this blocking? default-val) 60 | (let [d (-> (.take this default-val false) 61 | (d/timeout! timeout timeout-val))] 62 | (if blocking? 63 | @d 64 | d))))) 65 | 66 | (extend-protocol s/Sourceable 67 | Iterator 68 | (to-source [iterator] 69 | (->IteratorSource 70 | iterator 71 | (AtomicReference. (d/success-deferred true)))) 72 | 73 | BaseStream 74 | (to-source [stream] 75 | (->IteratorSource 76 | (.iterator ^BaseStream stream) 77 | (AtomicReference. (d/success-deferred true))))) 78 | -------------------------------------------------------------------------------- /src/manifold/test.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.test 2 | {:author "Moritz Heidkamp" 3 | :doc "Test utilities for Manifold consumers." 4 | :added "0.5.0"} 5 | (:require [clojure.test :as test] 6 | [manifold.debug :as debug])) 7 | 8 | (defn- report-dropped-errors! [dropped-errors] 9 | (when (pos? dropped-errors) 10 | ;; We include the assertion here within the `when` form so that we don't add a mystery assertion 11 | ;; to every passing test (which is the common case). 12 | (test/is (zero? dropped-errors) 13 | "Dropped errors detected! See log output for details."))) 14 | 15 | (defn- instrument-test-fn-with-dropped-error-detection [tf] 16 | (if (::detect-dropped-errors? tf) 17 | tf 18 | (with-meta 19 | (fn [] 20 | (binding [debug/*leak-aware-deferred-rate* 1] 21 | (debug/with-dropped-error-detection tf report-dropped-errors!))) 22 | {::detect-dropped-errors? true}))) 23 | 24 | (defn instrument-tests-with-dropped-error-detection! 25 | "Instrument all tests in the current namespace dropped error detection by wrapping them in 26 | `manifold.debug/with-dropped-error-detection`. If dropped errors are detected, a corresponding (failing) 27 | assertion is injected into the test and the leak reports are logged at level `error`. 28 | 29 | Usually placed at the end of a test namespace. 30 | 31 | Add `:ignore-dropped-errors` to a test var's metadata to skip it from being instrumented. 32 | 33 | Note that this is intentionally not implemented as a fixture since there is no clean way to make a 34 | test fail from within a fixture: Neither a failing assertion nor throwing an exception will 35 | preserve which particular test caused it. See 36 | e.g. https://github.com/technomancy/leiningen/issues/2694 for an example of this." 37 | [] 38 | (->> (ns-interns *ns*) 39 | vals 40 | (filter (comp :test meta)) 41 | (run! (fn [tv] 42 | (when-not (:ignore-dropped-errors (meta tv)) 43 | (alter-meta! tv update :test instrument-test-fn-with-dropped-error-detection)))))) 44 | 45 | (defmacro expect-dropped-errors 46 | "Expect n number of dropped errors after executing body in the form of a test assertion. 47 | 48 | Add `:ignore-dropped-errors` to the a test's metadata to be able to use this macro in an 49 | instrumented namespace (see `instrument-tests-with-dropped-error-detection!`)." 50 | [n & body] 51 | `(debug/with-dropped-error-detection 52 | (fn [] ~@body) 53 | (fn [n#] 54 | (test/is (= ~n n#) "Expected number of dropped errors doesn't match detected number of dropped errors.")))) 55 | -------------------------------------------------------------------------------- /resources/clj-kondo.exports/manifold/manifold/manifold/hooks.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.hooks 2 | (:require [clj-kondo.hooks-api :as api])) 3 | 4 | (defn- cons-vector-node 5 | [node parent] 6 | (api/vector-node (cons node (:children parent)))) 7 | 8 | (defn def-sink-or-source [call] 9 | (let [[name bindings & body] (-> call :node :children rest) 10 | extended-bindings 11 | (cons-vector-node (api/token-node 'lock) bindings)] 12 | 13 | {:node 14 | (api/list-node 15 | (list 16 | (api/token-node 'do) 17 | 18 | (api/list-node 19 | (list* 20 | (api/token-node 'deftype) 21 | name 22 | extended-bindings 23 | body)) 24 | 25 | (api/list-node 26 | (list 27 | (api/token-node 'defn) 28 | (api/token-node (symbol (str "->" (:string-value name)))) 29 | bindings))))})) 30 | 31 | (defn- seq-node? [node] 32 | (or (api/vector-node? node) 33 | (api/list-node? node))) 34 | 35 | (defn- nth-child [node n] (nth (:children node) n)) 36 | 37 | (defn both [call] 38 | (let [body (-> call :node :children second :children) 39 | expand-nth 40 | (fn [n item] 41 | (if (and (seq-node? item) (= 'either (:value (nth-child item 0)))) 42 | (:children (nth-child item n)) 43 | [item]))] 44 | 45 | {:node 46 | (api/list-node 47 | (list 48 | (api/token-node 'do) 49 | 50 | (api/list-node 51 | (->> body (mapcat (partial expand-nth 1)))) 52 | 53 | (api/list-node 54 | (->> body (mapcat (partial expand-nth 2))))))})) 55 | 56 | 57 | (def fallback-value 58 | "The fallback value used for declaration of local variables whose 59 | values are unknown at lint time." 60 | (api/list-node 61 | (list 62 | (api/token-node 'new) 63 | (api/token-node 'java.lang.Object)))) 64 | 65 | (defn success-error-unrealized [call] 66 | 67 | (let [[deferred 68 | success-value success-clause 69 | error-value error-clause 70 | unrealized-clause] (-> call :node :children rest)] 71 | 72 | (when-not (and deferred success-value success-clause error-value 73 | error-clause unrealized-clause) 74 | (throw (ex-info "Missing success-error-unrealized arguments" {}))) 75 | 76 | {:node 77 | (api/list-node 78 | (list 79 | (api/token-node 'do) 80 | 81 | (api/list-node 82 | (list 83 | (api/token-node 'let) 84 | (api/vector-node (vector success-value fallback-value)) 85 | success-clause)) 86 | 87 | (api/list-node 88 | (list 89 | (api/token-node 'let) 90 | (api/vector-node (vector error-value fallback-value)) 91 | error-clause)) 92 | 93 | unrealized-clause))})) 94 | -------------------------------------------------------------------------------- /test/manifold/time_test.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.time-test 2 | (:require 3 | [clojure.test :refer :all] 4 | [manifold.test :refer :all] 5 | [manifold.deferred :as d] 6 | [manifold.time :as t])) 7 | 8 | (deftest test-in 9 | (testing "side-effecting function" 10 | (let [n (atom 0)] 11 | @(t/in 1 #(swap! n inc)) 12 | (is (= 1 @n)))) 13 | 14 | (testing "function throws exception" 15 | (is (thrown? 16 | Exception 17 | @(t/in 1 (fn [] (throw (Exception. "Boom"))))))) 18 | 19 | (testing "delayed function returns deferred" 20 | (let [d (d/deferred)] 21 | (d/success! d 1) 22 | (is (= 1 @(t/in 1 (fn [] d)))))) 23 | 24 | (testing "delayed function returns failed deferred" 25 | (let [d (d/deferred)] 26 | (d/error! d (Exception. "BOOM")) 27 | (is (thrown? Exception @(t/in 1 (fn [] d)))))) 28 | 29 | (testing "cancelling by completing result deferred" 30 | (let [c (t/mock-clock 0)] 31 | (t/with-clock c 32 | (testing "with success" 33 | (let [n (atom 0) 34 | d (t/in 1 #(swap! n inc))] 35 | (d/success! d :cancel) 36 | (t/advance c 1) 37 | (is (= 0 @n)))) 38 | (testing "with error" 39 | (let [n (atom 0) 40 | d (t/in 1 #(swap! n inc))] 41 | (d/error! d (Exception. "cancel")) 42 | (t/advance c 1) 43 | (is (= 0 @n)))))))) 44 | 45 | (deftest test-every 46 | (let [n (atom 0) 47 | f (t/every 100 0 #(swap! n inc))] 48 | (Thread/sleep 10) 49 | (is (= 1 @n)) 50 | (Thread/sleep 100) 51 | (is (= 2 @n)) 52 | (f) 53 | (Thread/sleep 100) 54 | (is (= 2 @n)))) 55 | 56 | (deftest test-mock-clock 57 | (let [c (t/mock-clock 0) 58 | n (atom 0) 59 | inc #(swap! n inc)] 60 | (t/with-clock c 61 | 62 | (t/in 1 inc) 63 | (t/advance c 1) 64 | (is (= 1 @n)) 65 | 66 | (t/in 0 inc) 67 | (is (= 2 @n)) 68 | 69 | (t/in 1 inc) 70 | (t/in 1 inc) 71 | (t/advance c 1) 72 | (is (= 4 @n)) 73 | 74 | (let [cancel (t/every 5 1 inc)] 75 | (is (= 4 @n)) 76 | (t/advance c 1) 77 | (is (= 5 @n)) 78 | (t/advance c 1) 79 | (is (= 5 @n)) 80 | (t/advance c 4) 81 | (is (= 6 @n)) 82 | (t/advance c 20) 83 | (is (= 10 @n)) 84 | 85 | (cancel) 86 | (t/advance c 5) 87 | (is (= 10 @n)))))) 88 | 89 | (deftest test-mock-clock-deschedules-after-exception 90 | (let [c (t/mock-clock 0) 91 | counter (atom 0)] 92 | (t/with-clock c 93 | (t/every 1 94 | (fn [] 95 | (swap! counter inc) 96 | (throw (Exception. "BOOM"))))) 97 | (is (= 1 @counter)) 98 | (t/advance c 1) 99 | (is (= 1 @counter)))) 100 | 101 | (instrument-tests-with-dropped-error-detection!) 102 | -------------------------------------------------------------------------------- /test/manifold/executor_test.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.executor-test 2 | (:require 3 | [clojure.test :refer :all] 4 | [manifold.executor :as e] 5 | [manifold.test :refer :all]) 6 | (:import 7 | [io.aleph.dirigiste 8 | Executor 9 | Executor$Controller] 10 | [java.util.concurrent 11 | ExecutorService 12 | Executors 13 | LinkedBlockingQueue 14 | ThreadFactory])) 15 | 16 | (deftest test-instrumented-executor-uses-thread-factory 17 | (let [thread-count (atom 0) 18 | threadpool-prefix "my-pool-prefix-" 19 | thread-factory (e/thread-factory 20 | #(str threadpool-prefix (swap! thread-count inc)) 21 | (deliver (promise) nil)) 22 | controller (reify Executor$Controller 23 | (shouldIncrement [_ n] (< n 2)) 24 | (adjustment [_ s] 1)) 25 | executor (e/instrumented-executor 26 | {:controller controller 27 | :thread-factory thread-factory}) 28 | thread-names (LinkedBlockingQueue. 1)] 29 | (.execute ^Executor executor #(.put thread-names (.getName (Thread/currentThread)))) 30 | (is (contains? #{(str threadpool-prefix 1) (str threadpool-prefix 2)} (.take thread-names))))) 31 | 32 | (deftest test-rt-dynamic-classloader 33 | (let [num-threads (atom 0) 34 | in-thread-loader (promise) 35 | tf (e/thread-factory 36 | #(str "my-loader-prefix-" (swap! num-threads inc)) 37 | (deliver (promise) nil)) 38 | executor (Executors/newFixedThreadPool 1 ^ThreadFactory tf)] 39 | (.execute ^ExecutorService executor 40 | (fn [] 41 | (let [l (clojure.lang.RT/baseLoader)] 42 | (deliver in-thread-loader l)))) 43 | (is (instance? clojure.lang.DynamicClassLoader @in-thread-loader)))) 44 | 45 | (defn- ^ThreadFactory thread-factory 46 | ([] (thread-factory nil)) 47 | ([new-thread-fn] (thread-factory new-thread-fn nil)) 48 | ([new-thread-fn stack-size] 49 | (let [num-threads (atom 0) 50 | tf (e/thread-factory 51 | #(str "my-pool-prefix" (swap! num-threads inc)) 52 | (deliver (promise) nil) 53 | stack-size 54 | false 55 | new-thread-fn)] 56 | tf))) 57 | 58 | (deftest test-thread-factory 59 | (let [tf (thread-factory)] 60 | (is (.newThread tf (constantly nil)))) 61 | (let [tf (thread-factory 62 | (fn [group target _ stack-size] 63 | (Thread. group target "custom-name" stack-size))) 64 | thread (.newThread tf (constantly nil))] 65 | (is (= "custom-name" (.getName thread)))) 66 | (let [tf (thread-factory 67 | (fn [group target _ stack-size] 68 | (Thread. group target "custom-name" stack-size)) 69 | 500) 70 | thread (.newThread tf (constantly nil))] 71 | (is (= "custom-name" (.getName thread))))) 72 | 73 | (instrument-tests-with-dropped-error-detection!) 74 | -------------------------------------------------------------------------------- /doc/rationale.md: -------------------------------------------------------------------------------- 1 | Manifold provides representations for data we don't yet have, and tools for acting upon it. Sometimes this data is something we can compute ourselves, but more often it's sent to us by something outside our process. And since we don't control when the data arrives, it's likely that sometimes it will arrive faster than we can process it. 2 | 3 | This means that we not only need to correctly process the data, we need to have a strategy for when we get too much of it. [This is discussed in depth in this talk](https://www.youtube.com/watch?v=1bNOO3xxMc0), but the typical strategy is to use **backpressure**, which is a signal sent to the producer that we can't handle more messages, and a subsequent message that we now can. 4 | 5 | Backpressure is a fundamental property of Java's threading model, as shown by `BlockingQueues`, `Futures`, `InputStreams`, and others. It's also a fundamental property of `core.async` channels, though it uses a completely different execution model built on callbacks and macros. It's also a fundamental property of Clojure's lazy sequences, which like Java's abstractions are blocking, but unlike both Java and `core.async` relies on pulling data towards the consumer rather than having it pushed. 6 | 7 | Unfortunately, while all of these abstractions (or [RxJava](https://github.com/ReactiveX/RxJava), or [Reactive Streams](http://www.reactive-streams.org/), or ...) can be used to similar effects, they don't necessarily work well with each other. The practical effect of this is that by choosing one abstraction, we often make the others off-limits. When writing an application, this may be acceptable, if not really desirable. When writing a library or something meant to be reused, though, it's much worse; only people who have chosen your particular walled garden can use your work. 8 | 9 | Manifold provides abstractions that sits at the intersection of all these similar, but incompatible, approaches. It provides an extensible mechanism for coercing unrealized data into a generic form, and piping data from these generic forms into other stream representations. 10 | 11 | It has relatively few central ideas: 12 | 13 | * pervasive asynchrony, emulated by wrapping threads around synchronous objects where necessary 14 | * all asynchronous values and operations represented as deferreds 15 | * streams can either be message **sources**, message **sinks**, or both 16 | * sources are interacted with via `take!`, `try-take!`, and `close!` 17 | * sinks are interacted with via `put!`, `try-put!`, and `close!` 18 | * messages from anything which is "sourceable" can be piped into anything which is "sinkable" via `manifold.stream/connect` 19 | * the topology created via `connect` is explicit, and can be walked and queried 20 | * both deferreds and streams can have their execution pushed onto a thread pool via their respective `onto` methods 21 | 22 | Manifold is not intended to be as feature-rich as other stream libraries, but rather to be just feature-rich enough to enable library developers to use it as an asynchronous [lingua franca](http://en.wikipedia.org/wiki/Lingua_franca). It is, at this moment, fully functional but subject to change. Feedback is welcomed. -------------------------------------------------------------------------------- /src/manifold/stream/seq.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.stream.seq 2 | {:no-doc true} 3 | (:require 4 | [clojure.tools.logging :as log] 5 | [manifold.deferred :as d] 6 | [manifold.utils :as utils] 7 | [manifold.stream 8 | [core :as s] 9 | [graph :as g]] 10 | [manifold.time :as time]) 11 | (:import 12 | [java.util.concurrent.atomic 13 | AtomicReference])) 14 | 15 | (s/def-source SeqSource 16 | [s-ref 17 | ^AtomicReference last-take] 18 | 19 | (isSynchronous [_] 20 | (let [s @s-ref] 21 | (and 22 | (instance? clojure.lang.IPending s) 23 | (not (realized? s))))) 24 | 25 | (close [_] 26 | (let [s @s-ref] 27 | (if (instance? java.io.Closeable s) 28 | (.close ^java.io.Closeable s)))) 29 | 30 | (description [this] 31 | (merge 32 | {:type "seq" 33 | :drained? (s/drained? this)} 34 | (let [s @s-ref] 35 | (when (counted? s) 36 | {:count (count s)})))) 37 | 38 | (take [this default-val blocking?] 39 | (if blocking? 40 | 41 | (let [s @s-ref] 42 | (if (empty? s) 43 | (do 44 | (.markDrained this) 45 | default-val) 46 | (let [x (first s)] 47 | (swap! s-ref rest) 48 | x))) 49 | 50 | (let [d (d/deferred) 51 | d' (.getAndSet last-take d) 52 | f (fn [_] 53 | (let [s @s-ref] 54 | (if (or (not (instance? clojure.lang.IPending s)) 55 | (realized? s)) 56 | (if (empty? s) 57 | (do 58 | (.markDrained this) 59 | (d/success! d default-val)) 60 | (let [x (first s)] 61 | (when-let [token (d/claim! d)] 62 | (swap! s-ref rest) 63 | (d/success! d x token)))) 64 | (utils/wait-for 65 | (try 66 | (if (empty? s) 67 | (do 68 | (.markDrained this) 69 | (d/success! d default-val)) 70 | (let [x (first s)] 71 | (when-let [token (d/claim! d)] 72 | (swap! s-ref rest) 73 | (d/success! d x token)))) 74 | (catch Throwable e 75 | (log/error e "error in seq stream") 76 | (.markDrained this) 77 | (d/success! d default-val)))))))] 78 | (if (d/realized? d') 79 | (f nil) 80 | (d/on-realized d' f f)) 81 | d))) 82 | 83 | (take [this default-val blocking? timeout timeout-val] 84 | (if (nil? timeout) 85 | (.take this blocking? default-val) 86 | (let [d (-> (.take this false default-val) 87 | (d/timeout! timeout timeout-val))] 88 | (if blocking? 89 | @d 90 | d))))) 91 | 92 | (extend-protocol s/Sourceable 93 | 94 | clojure.lang.ISeq 95 | (to-source [s] 96 | (->SeqSource 97 | (atom s) 98 | (AtomicReference. (d/success-deferred true)))) 99 | 100 | clojure.lang.Seqable 101 | (to-source [s] 102 | (->SeqSource 103 | (atom (seq s)) 104 | (AtomicReference. (d/success-deferred true))))) 105 | -------------------------------------------------------------------------------- /doc/execution.md: -------------------------------------------------------------------------------- 1 | Concurrent systems separate **what** happens from **when** it happens. This is typically accomplished by specifying what the programmers wants to happen (e.g. callbacks), and layering atop an execution model that decides when and where the code should be run (e.g. one or more threads reading from a queue of callbacks to be invoked). Often, this execution model is hard-coded, making interop between different stream representations much harder than necessary. 2 | 3 | Manifold tries to make its execution model as configurable as possible, while still remaining functional for users who don't want to fiddle with the low-level details. Under different circumstances, Manifold will lazily construct three different pools: 4 | 5 | * *wait-pool* - Used solely to wait on blocking operations. Only created when `manifold.stream/connect` is used on blocking stream abstractions like `java.util.BlockingQueue` or Clojure seqs, or when `manifold.deferred/chain` is used with abstractions like `java.util.concurrent.Future` or Clojure promises. This is an instrumented pool, and statistics can be consumed via `manifold.executor/register-wait-pool-stats-callback`. 6 | * *execute-pool* - Used to execute `manifold.deferred/future` bodies, and only created if that macro is used. This is an instrumented pool, and statistics can be consumed via `manifold.executor/register-execute-pool-stats-callback`. 7 | * *scheduler-pool* - Used to execute delayed tasks, periodic tasks, or timeouts. Only created when `manifold.time/in`, `manifold.time/every`, `manifold.stream/periodically`, or take/put timeouts are used. 8 | 9 | However, by default, messages are processed on whatever thread they were originally `put!` on. This can get more complicated if multiple threads are calling `put!` on the same stream at the same time, in which case one thread may propagate messages from the other thread. In general, this means that Manifold conforms to whatever the surrounding execution model is, and users can safely use it in concert with other frameworks. 10 | 11 | This also means that `put!` will only return once the message has been completely propagated through the downstream topology, which is not always the desired behavior. The same is also true for a deferred with a long chain of methods waiting on it to be realized. Conversely, in core.async each hand-off between goroutines is a new task enqueued onto the main thread pool. This gives better guarantees as to how long an enqueue operation will take before it returns, which can be useful in some situations. 12 | 13 | In these cases, we can move the stream or deferred `onto` an executor, guaranteeing that all actions resulting from an operation will be enqueued onto a thread pool rather than immediately executed. This executor can be generated via `manifold.executor/instrumented-executor`, or using the convenience methods `fixed-thread-executor` and `utilization-executor`. In addition to providing automatic instrumentation, these executors will guarantee that any streams or deferred created within their scope will also be "on" that executor. For this reason, it's often sufficient to only call `onto` on a single stream in a topology, as everything downstream of it will transitively be executed on the executor. 14 | 15 | ```clojure 16 | (require '[manifold.deferred :as d] 17 | '[manifold.stream :as s]) 18 | 19 | (def executor (fixed-thread-executor 42)) 20 | 21 | (-> (d/future 1) 22 | (d/onto executor) 23 | (d/chain inc inc inc)) 24 | 25 | (->> (s/->source (range 1e3)) 26 | (s/onto executor) 27 | (s/map inc)) 28 | ``` 29 | 30 | If you want to specify your own thread pool, it's important to note that such thread pools in practice either need to have an unbounded queue or an unbounded number of threads. This is because thread pools with bounded queues and threads will throw a `RejectedExecutionException` when they're full, which can leave our message processing in an undefined state if we're only halfway through the message topology. It's important to note, though, that the maximum number of enqueued actions is **not** equal to the number of messages we need to process, but rather to the number of nodes in our topology. This number is usually either fixed, or proportional to something else we can control, such as the number of open connections. In either case, it is not something that a single external actor can artificially inflate (or at least it shouldn't be). 31 | 32 | This configurability is necessary given Manifold's goal of interop with other stream representations, but is only meant to be used by those who need it. Most can, and should, ignore it. 33 | -------------------------------------------------------------------------------- /src/manifold/utils.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.utils 2 | {:no-doc true} 3 | (:refer-clojure 4 | :exclude [future]) 5 | (:require 6 | [clojure.tools.logging :as log] 7 | [manifold.executor :as ex] 8 | [potemkin.types] 9 | [clj-commons.primitive-math :as p]) 10 | (:import 11 | [java.util.concurrent 12 | Executors 13 | Executor 14 | ThreadFactory 15 | BlockingQueue 16 | ConcurrentHashMap] 17 | [java.util.concurrent.locks 18 | ReentrantLock 19 | Lock])) 20 | 21 | ;;; 22 | 23 | (defmacro wait-for [& body] 24 | `(let [f# (fn [] 25 | (try 26 | ~@body 27 | (catch Throwable e# 28 | (log/error e# "error in manifold.utils/wait-for"))))] 29 | (.execute ^Executor (ex/wait-pool) ^Runnable f#) 30 | nil)) 31 | 32 | (defmacro future-with [executor & body] 33 | `(let [frame# (clojure.lang.Var/cloneThreadBindingFrame) 34 | ^Executor executor# ~executor 35 | f# (fn [] 36 | (let [curr-frame# (clojure.lang.Var/getThreadBindingFrame)] 37 | (clojure.lang.Var/resetThreadBindingFrame frame#) 38 | (try 39 | ~@body 40 | (catch Throwable e# 41 | (log/error e# "error in manifold.utils/future-with")) 42 | (finally 43 | (clojure.lang.Var/resetThreadBindingFrame curr-frame#)))))] 44 | (.execute executor# ^Runnable f#) 45 | nil)) 46 | 47 | ;;; 48 | 49 | (def ^ThreadLocal stack-depth (ThreadLocal.)) 50 | 51 | (def ^:const max-depth 50) 52 | 53 | (defmacro without-overflow [executor & body] 54 | `(let [depth# (.get stack-depth) 55 | depth'# (if (nil? depth#) 0 depth#) 56 | f# (fn [] ~@body)] 57 | (if (p/> depth'# max-depth) 58 | (future-with ~executor (f#)) 59 | (try 60 | (.set stack-depth (unchecked-inc (unchecked-long depth'#))) 61 | (f#) 62 | (finally 63 | (when (nil? depth#) 64 | (.set stack-depth nil))))))) 65 | 66 | ;;; 67 | 68 | (defn invoke-callbacks [^BlockingQueue callbacks] 69 | (loop [] 70 | (when-let [c (.poll callbacks)] 71 | (try 72 | (c) 73 | (catch Throwable e 74 | (log/error e "error in invoke-callbacks"))) 75 | (recur)))) 76 | 77 | ;;; 78 | 79 | (defn fast-satisfies [protocol-var] 80 | (let [^ConcurrentHashMap classes (ConcurrentHashMap.)] 81 | (add-watch protocol-var ::memoization (fn [& _] (.clear classes))) 82 | (fn [x] 83 | (if (nil? x) 84 | false 85 | (let [cls (class x) 86 | val (.get classes cls)] 87 | (if (nil? val) 88 | (let [val (satisfies? @protocol-var x)] 89 | (.put classes cls val) 90 | val) 91 | val)))))) 92 | 93 | ;;; 94 | 95 | (defn mutex [] 96 | (ReentrantLock.)) 97 | 98 | (defmacro with-lock [lock & body] 99 | `(let [^java.util.concurrent.locks.Lock lock# ~lock] 100 | (.lock lock#) 101 | (try 102 | ~@body 103 | (finally 104 | (.unlock lock#))))) 105 | 106 | (defmacro with-lock* [lock & body] 107 | `(let [^java.util.concurrent.locks.Lock lock# ~lock] 108 | (.lock lock#) 109 | (let [x# (do ~@body)] 110 | (.unlock lock#) 111 | x#))) 112 | 113 | ;;; 114 | 115 | (defmacro when-core-async 116 | "Suitable for altering behavior (like extending protocols), but not defs" 117 | [& body] 118 | (when (try 119 | (require '[clojure.core.async]) 120 | true 121 | (catch Exception _ 122 | false)) 123 | `(do ~@body))) 124 | 125 | (defmacro when-class [class & body] 126 | (when (try 127 | (Class/forName (name class)) 128 | (catch Exception _ 129 | false)) 130 | `(do ~@body))) 131 | 132 | ;;; 133 | 134 | (defmacro definterface+ [name & body] 135 | (when-not (resolve name) 136 | `(definterface ~name ~@body))) 137 | 138 | ;;; 139 | 140 | (defn fn->Function [f] 141 | (reify java.util.function.Function 142 | (apply [_ x] (f x)))) 143 | 144 | (defn fn->Consumer [f] 145 | (reify java.util.function.Consumer 146 | (accept [_ x] (f x)))) 147 | 148 | 149 | (defn fn->BiFunction [f] 150 | (reify java.util.function.BiFunction 151 | (apply [_ x y] (f x y)))) 152 | 153 | (defn fn->BiConsumer [f] 154 | (reify java.util.function.BiConsumer 155 | (accept [_ x y] (f x y)))) 156 | 157 | 158 | (defmacro ^:no-doc assert-some 159 | "Throws NullPointerException if any of the arguments is null." 160 | [& values] 161 | `(do ~@(for [value values] 162 | `(let [value# ~value] 163 | (when (nil? value#) 164 | (throw (NullPointerException. ~(str value " was null")))))))) 165 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![Clojars Project](https://img.shields.io/clojars/v/manifold.svg)](https://clojars.org/manifold) 2 | [![cljdoc badge](https://cljdoc.org/badge/manifold/manifold)](https://cljdoc.org/d/manifold/manifold) 3 | [![CircleCI](https://circleci.com/gh/clj-commons/manifold.svg?style=svg)](https://circleci.com/gh/clj-commons/manifold) 4 | ![](doc/manifold.png) 5 | 6 | Manifold provides basic building blocks for asynchronous programming, and can be used as a translation layer between libraries which use similar, but incompatible, abstractions. 7 | 8 | Manifold provides two core abstractions: **deferreds**, which represent a single asynchronous value, and **streams**, which represent an ordered sequence of asynchronous values. 9 | 10 | A detailed discussion of Manifold's rationale can be found [here](doc/rationale.md). Full documentation can be found [here](https://cljdoc.org/d/manifold/manifold). 11 | 12 | Leiningen: 13 | ```clojure 14 | [manifold "0.4.4"] 15 | ``` 16 | 17 | deps.edn: 18 | ```clojure 19 | manifold/manifold {:mvn/version "0.4.4"} 20 | ``` 21 | 22 | ### Deferreds 23 | 24 | A deferred in Manifold is similar to a Clojure promise: 25 | 26 | ```clojure 27 | > (require '[manifold.deferred :as d]) 28 | nil 29 | 30 | > (def d (d/deferred)) 31 | #'d 32 | 33 | > (d/success! d :foo) 34 | true 35 | 36 | > @d 37 | :foo 38 | ``` 39 | 40 | However, similar to Clojure's futures, deferreds in Manifold can also represent errors. Crucially, they also allow for callbacks to be registered, rather than simply blocking on dereferencing. 41 | 42 | ```clojure 43 | > (def d (d/deferred)) 44 | #'d 45 | 46 | > (d/error! d (Exception. "boom")) 47 | true 48 | 49 | > @d 50 | Exception: boom 51 | ``` 52 | 53 | ```clojure 54 | > (def d (d/deferred)) 55 | #'d 56 | 57 | > (d/on-realized d 58 | (fn [x] (println "success!" x)) 59 | (fn [x] (println "error!" x))) 60 | << ... >> 61 | 62 | > (d/success! d :foo) 63 | success! :foo 64 | true 65 | ``` 66 | 67 | Callbacks are a useful building block, but they're a painful way to create asynchronous workflows. In practice, **no one should ever need to use `on-realized`**. Manifold provides a number of operators for composing over deferred values, [which can be read about here](/doc/deferred.md). 68 | 69 | ### Streams 70 | 71 | Manifold's streams provide mechanisms for asynchronous puts and takes, timeouts, and backpressure. They are compatible with Java's `BlockingQueues`, Clojure's lazy sequences, and core.async's channels. Methods for converting to and from each are provided. 72 | 73 | Manifold differentiates between **sources**, which emit messages, and **sinks**, which consume messages. We can interact with sources using `take!` and `try-take!`, which return deferred values representing the next message. We can interact with sinks using `put!` and `try-put!`, which return a deferred values which will yield `true` if the put is successful, or `false` otherwise. 74 | 75 | We can create a stream using `(manifold.stream/stream)`: 76 | 77 | ```clojure 78 | > (require '[manifold.stream :as s]) 79 | nil 80 | > (def s (s/stream)) 81 | #'s 82 | > (s/put! s 1) 83 | << ... >> 84 | > (s/take! s) 85 | << 1 >> 86 | ``` 87 | 88 | A stream is both a sink and a source; any message sent via `put!` can be received via `take!`. We can also create sinks and sources from other stream representations using `->sink` and `->source`: 89 | 90 | ```clojure 91 | > (require '[clojure.core.async :as a]) 92 | nil 93 | > (def c (a/chan)) 94 | #'c 95 | > (def s (s/->source c)) 96 | #'s 97 | > (a/go (a/>! c 1)) 98 | #object[clojure.core.async.impl.channels.ManyToManyChannel 0x7... 99 | > @(s/take! s) 100 | 1 101 | ``` 102 | 103 | We can also turn a Manifold stream into a different representation by using `connect` to join them together: 104 | 105 | ```clojure 106 | > (def s (s/stream)) 107 | #'s 108 | > (def c (a/chan)) 109 | #'c 110 | > (s/connect s c) 111 | nil 112 | > (s/put! s 1) 113 | << true >> 114 | > (a/YourKit Java Profiler, YourKit .NET Profiler, and YourKit YouMonitor. 136 | 137 | ![](https://www.yourkit.com/images/yklogo.png) 138 | -------------------------------------------------------------------------------- /src/manifold/stream/queue.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.stream.queue 2 | {:no-doc true} 3 | (:require 4 | [clj-commons.primitive-math :as p] 5 | [manifold.stream.graph :as g] 6 | [manifold.deferred :as d] 7 | [manifold.stream.core :as s] 8 | [manifold.utils :as utils]) 9 | (:import 10 | [java.util.concurrent.atomic 11 | AtomicReference] 12 | [java.util.concurrent 13 | BlockingQueue 14 | LinkedBlockingQueue 15 | TimeUnit])) 16 | 17 | (s/def-source BlockingQueueSource 18 | [^BlockingQueue queue 19 | ^AtomicReference last-take] 20 | 21 | (isSynchronous [_] 22 | true) 23 | 24 | (description [_] 25 | {:type (.getCanonicalName (class queue)) 26 | :buffer-size (.size queue) 27 | :source? true}) 28 | 29 | (take [this default-val blocking?] 30 | (if blocking? 31 | 32 | (.take queue) 33 | 34 | (let [d (d/deferred) 35 | d' (.getAndSet last-take d) 36 | f (fn [_] 37 | (let [x (.poll queue)] 38 | (if (nil? x) 39 | 40 | (utils/wait-for 41 | (d/success! d (.take queue))) 42 | 43 | (d/success! d x))))] 44 | (if (d/realized? d') 45 | (f nil) 46 | (d/on-realized d' f f)) 47 | d))) 48 | 49 | (take [this default-val blocking? timeout timeout-val] 50 | (if blocking? 51 | 52 | (let [x (.poll queue timeout TimeUnit/MILLISECONDS)] 53 | (if (nil? x) 54 | timeout-val 55 | x)) 56 | 57 | (let [d (d/deferred) 58 | d' (.getAndSet last-take d) 59 | f (fn [_] 60 | (let [x (.poll queue)] 61 | (if (nil? x) 62 | 63 | (utils/wait-for 64 | (d/success! d 65 | (let [x (.poll queue timeout TimeUnit/MILLISECONDS)] 66 | (if (nil? x) 67 | timeout-val 68 | x)))) 69 | 70 | (d/success! d x))))] 71 | (if (d/realized? d') 72 | (f nil) 73 | (d/on-realized d' f f)) 74 | d)))) 75 | 76 | 77 | (s/def-sink BlockingQueueSink 78 | [^BlockingQueue queue 79 | ^AtomicReference last-put] 80 | 81 | (isSynchronous [_] 82 | true) 83 | 84 | (close [this] 85 | (.markClosed this)) 86 | 87 | (description [this] 88 | (let [size (.size queue)] 89 | {:type (.getCanonicalName (class queue)) 90 | :buffer-capacity (p/+ (.remainingCapacity queue) size) 91 | :buffer-size size 92 | :sink? true 93 | :closed? (.isClosed this)})) 94 | 95 | (put [this x blocking?] 96 | 97 | (assert (not (nil? x)) "BlockingQueue cannot take `nil` as a message") 98 | 99 | (if blocking? 100 | 101 | (do 102 | (.put queue x) 103 | true) 104 | 105 | (let [d (d/deferred) 106 | d' (.getAndSet last-put d) 107 | f (fn [_] 108 | (utils/with-lock lock 109 | (try 110 | (or 111 | (and (.isClosed this) 112 | (d/success! d false)) 113 | 114 | (and (.offer queue x) 115 | (d/success! d true)) 116 | 117 | (utils/wait-for 118 | (d/success! d 119 | (do 120 | (.put queue x) 121 | true)))))))] 122 | (if (d/realized? d') 123 | (f nil) 124 | (d/on-realized d' f f)) 125 | d))) 126 | 127 | (put [this x blocking? timeout timeout-val] 128 | 129 | (assert (not (nil? x)) "BlockingQueue cannot take `nil` as a message") 130 | 131 | (if blocking? 132 | 133 | (.offer queue x timeout TimeUnit/MILLISECONDS) 134 | 135 | (let [d (d/deferred) 136 | d' (.getAndSet last-put d) 137 | f (fn [_] 138 | (utils/with-lock lock 139 | (try 140 | (or 141 | (and (.isClosed this) 142 | (d/success! d false)) 143 | 144 | (and (.offer queue x) 145 | (d/success! d true)) 146 | 147 | (utils/wait-for 148 | (d/success! d 149 | (if (.offer queue x timeout TimeUnit/MILLISECONDS) 150 | true 151 | false)))))))] 152 | (if (d/realized? d') 153 | (f nil) 154 | (d/on-realized d' f f)) 155 | d)))) 156 | 157 | ;;; 158 | 159 | (extend-protocol s/Sinkable 160 | 161 | BlockingQueue 162 | (to-sink [queue] 163 | (->BlockingQueueSink 164 | queue 165 | (AtomicReference. (d/success-deferred true))))) 166 | 167 | (extend-protocol s/Sourceable 168 | 169 | BlockingQueue 170 | (to-source [queue] 171 | (->BlockingQueueSource 172 | queue 173 | (AtomicReference. (d/success-deferred true))))) 174 | -------------------------------------------------------------------------------- /src/manifold/bus.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.bus 2 | {:author "Zach Tellman" 3 | :doc "An implementation of an event bus, where publishers and subscribers can interact via topics."} 4 | (:require 5 | [manifold 6 | [stream :as s] 7 | [deferred :as d] 8 | [utils :refer [definterface+]]] 9 | [potemkin.types :refer [deftype+]] 10 | [clj-commons.primitive-math :as p]) 11 | (:import 12 | [java.util.concurrent 13 | ConcurrentHashMap] 14 | [java.lang.reflect 15 | Array])) 16 | 17 | (set! *unchecked-math* true) 18 | 19 | (definterface+ IEventBus 20 | (snapshot []) 21 | (subscribe [topic]) 22 | (downstream [topic]) 23 | (publish [topic message]) 24 | (isActive [topic])) 25 | 26 | (definline publish! 27 | "Publishes a message on the bus, returning a deferred result representing the message 28 | being accepted by all subscribers. To prevent one slow consumer from blocking all 29 | the others, use `manifold.stream/buffer`, or `manifold.stream/connect` with a timeout 30 | specified." 31 | [bus topic message] 32 | `(.publish ~(with-meta bus {:tag "manifold.bus.IEventBus"}) ~topic ~message)) 33 | 34 | (definline subscribe 35 | "Returns a stream which consumes all messages from `topic`." 36 | [bus topic] 37 | `(.subscribe ~(with-meta bus {:tag "manifold.bus.IEventBus"}) ~topic)) 38 | 39 | (definline downstream 40 | "Returns a list of all streams subscribed to `topic`." 41 | [bus topic] 42 | `(.downstream ~(with-meta bus {:tag "manifold.bus.IEventBus"}) ~topic)) 43 | 44 | (definline active? 45 | "Returns `true` if there are any subscribers to `topic`." 46 | [bus topic] 47 | `(.isActive ~(with-meta bus {:tag "manifold.bus.IEventBus"}) ~topic)) 48 | 49 | (definline topic->subscribers 50 | [bus] 51 | `(.snapshot ~(with-meta bus {:tag "manifold.bus.IEventBus"}))) 52 | 53 | (defn- conj' [ary x] 54 | (if (nil? ary) 55 | (object-array [x]) 56 | (let [len (Array/getLength ary) 57 | ary' (object-array (p/inc len))] 58 | (System/arraycopy ary 0 ary' 0 len) 59 | (aset ^objects ary' len x) 60 | ary'))) 61 | 62 | (defn- disj' [^objects ary x] 63 | (let [len (Array/getLength ary)] 64 | (if-let [idx (loop [i 0] 65 | (if (p/<= len i) 66 | nil 67 | (if (identical? x (aget ary i)) 68 | i 69 | (recur (p/inc i)))))] 70 | (let [idx (p/long idx)] 71 | (if (p/== 1 len) 72 | nil 73 | (let [ary' (object-array (p/dec len))] 74 | (System/arraycopy ary 0 ary' 0 idx) 75 | (System/arraycopy ary (p/inc idx) ary' idx (p/- len idx 1)) 76 | ary'))) 77 | ary))) 78 | 79 | (deftype+ Wrapper [x] 80 | Object 81 | (hashCode [_] (hash x)) 82 | (equals [_ o] (= x (.x ^Wrapper o)))) 83 | 84 | (defn- wrap [x] 85 | (Wrapper. x)) 86 | 87 | (defn- unwrap [w] 88 | (.x ^Wrapper w)) 89 | 90 | (defn event-bus 91 | "Returns an event bus that can be used with `publish!` and `subscribe`." 92 | ([] 93 | (event-bus s/stream)) 94 | ([stream-generator] 95 | (let [topic->subscribers (ConcurrentHashMap.)] 96 | (reify IEventBus 97 | 98 | (snapshot [_] 99 | (->> topic->subscribers 100 | (map 101 | (fn [[topic subscribers]] 102 | (clojure.lang.MapEntry. (unwrap topic) (into [] subscribers)))) 103 | (into {}))) 104 | 105 | (subscribe [_ topic] 106 | (let [s (stream-generator)] 107 | 108 | ;; CAS to add 109 | (loop [] 110 | (let [subscribers (.get topic->subscribers (wrap topic)) 111 | subscribers' (conj' subscribers s)] 112 | (if (nil? subscribers) 113 | (when (.putIfAbsent topic->subscribers (wrap topic) subscribers') 114 | (recur)) 115 | (when-not (.replace topic->subscribers (wrap topic) subscribers subscribers') 116 | (recur))))) 117 | 118 | ;; CAS to remove 119 | (s/on-closed s 120 | (fn [] 121 | (loop [] 122 | (let [subscribers (.get topic->subscribers (wrap topic)) 123 | subscribers' (disj' subscribers s)] 124 | (if (nil? subscribers') 125 | (when-not (.remove topic->subscribers (wrap topic) subscribers) 126 | (recur)) 127 | (when-not (.replace topic->subscribers (wrap topic) subscribers subscribers') 128 | (recur))))))) 129 | 130 | (s/source-only s))) 131 | 132 | (publish [_ topic message] 133 | (let [subscribers (.get topic->subscribers (wrap topic))] 134 | (if (nil? subscribers) 135 | (d/success-deferred false) 136 | (-> (apply d/zip' (map #(s/put! % message) subscribers)) 137 | (d/chain' (fn [_] true)))))) 138 | 139 | (downstream [_ topic] 140 | (seq (.get topic->subscribers (wrap topic)))) 141 | 142 | (isActive [_ topic] 143 | (boolean (.get topic->subscribers (wrap topic)))))))) 144 | -------------------------------------------------------------------------------- /src/manifold/stream/async.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.stream.async 2 | {:no-doc true} 3 | (:require 4 | [manifold.deferred :as d] 5 | [clojure.core.async :as a] 6 | [manifold.stream 7 | [graph :as g] 8 | [core :as s]] 9 | [manifold 10 | [executor :as executor] 11 | [utils :as utils]]) 12 | (:import 13 | [java.util.concurrent.atomic 14 | AtomicReference])) 15 | 16 | (s/def-source CoreAsyncSource 17 | [ch ^AtomicReference last-take] 18 | 19 | (isSynchronous [_] false) 20 | 21 | (description [this] 22 | {:source? true 23 | :drained? (s/drained? this) 24 | :type "core.async"}) 25 | 26 | (close [_] 27 | (a/close! ch)) 28 | 29 | (take [this default-val blocking?] 30 | (if blocking? 31 | 32 | (let [x (a/!! ch x) 116 | true) 117 | 118 | :else 119 | (let [d (d/deferred) 120 | d' (.getAndSet last-put d) 121 | f (fn [_] 122 | (a/go 123 | (d/success! d 124 | (boolean 125 | (a/>! ch x)))))] 126 | (if (d/realized? d') 127 | (f nil) 128 | (d/on-realized d' f f)) 129 | d)))) 130 | 131 | (put [this x blocking? timeout timeout-val] 132 | 133 | (if (nil? timeout) 134 | (.put this x blocking?) 135 | (assert (not (nil? x)) "core.async channel cannot take `nil` as a message")) 136 | 137 | (utils/with-lock lock 138 | 139 | (if (s/closed? this) 140 | 141 | (if blocking? 142 | false 143 | (d/success-deferred false)) 144 | 145 | (let [d (d/deferred) 146 | d' (.getAndSet last-put d) 147 | f (fn [_] 148 | (a/go 149 | (let [result (a/alt! 150 | [[ch x]] true 151 | (a/timeout timeout) timeout-val 152 | :priority true)] 153 | (d/success! d result))))] 154 | (if (d/realized? d') 155 | (f nil) 156 | (d/on-realized d' f f)) 157 | (if blocking? 158 | @d 159 | d)))))) 160 | 161 | (extend-protocol s/Sinkable 162 | 163 | clojure.core.async.impl.channels.ManyToManyChannel 164 | (to-sink [ch] 165 | (->CoreAsyncSink 166 | ch 167 | (AtomicReference. (d/success-deferred true))))) 168 | 169 | (extend-protocol s/Sourceable 170 | 171 | clojure.core.async.impl.channels.ManyToManyChannel 172 | (to-source [ch] 173 | (->CoreAsyncSource 174 | ch 175 | (AtomicReference. (d/success-deferred true))))) 176 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | ### 0.4.4 2 | 3 | * Fix various leaked error deferreds (#245, #248, #249, #250, #252, #253) 4 | 5 | Contributions by (in alphabetical order): Balint Erdos, Dave Roberts, Matthew Davidson, Moritz Heidkamp, Renan Ribeiro 6 | 7 | ### 0.4.3 8 | 9 | * Improved clj-kondo exports 10 | 11 | Contributions by Jacob Maine and Ferdinand Beyer 12 | 13 | ### 0.4.2 14 | 15 | Contributions by Matthew Davidson, Eric Dvorsak, and Arnaud Geiser 16 | 17 | * Fixes a `print-method` dispatch hierarchy bug when also using Promesa. 18 | 19 | ### 0.4.1 20 | 21 | Contributions by Ryan Smith 22 | 23 | * Fixes a bug in `go-off` when using newer versions of core.async. 24 | 25 | ### 0.4.0 26 | 27 | Contributions by Renan Ribeiro, Matthew Davidson, and Arnaud Geiser 28 | 29 | * Manifold deferreds now implement CompletionStage 30 | * Add clj-kondo support to many macros 31 | * Clarify how/when upstreams are automatically closed 32 | * Many docstring improvements 33 | * Fixed bug in `go-off` test 34 | 35 | Special thanks to newcomer Renan Ribeiro for his major contributions to this release! 36 | 37 | ### 0.3.0 38 | 39 | Contributions by Ryan Schmukler and Matthew Davidson 40 | 41 | * Added new windowing stream fns, `sliding-stream` and `dropping-stream` 42 | * Java 8 is now the minimum version supported 43 | * Fixed accidental usage of core `realized?` in `stream->seq` 44 | * Fixed broken BaseStream test 45 | * Update CircleCI Docker image 46 | * Update Dirigiste, tools.logging, riddley, and core.async versions 47 | * Add deps.edn usage instructions 48 | * Removed Codox 49 | * Cleaned up timing tests and ns metadata 50 | 51 | ### 0.2.4 52 | 53 | Contributions by Arnaud Geiser 54 | 55 | * Support custom `Thread` classes with Manifold's executor 56 | 57 | ### 0.2.3 58 | 59 | Contributions by Matthew Davidson 60 | 61 | * Added `manifold.go-off` to generated documentation 62 | 63 | ### 0.2.2 64 | 65 | Contributions by Matthew Davidson 66 | 67 | * Renamed `go-off-executor` to `go-off-with` to match existing `future-with` macro 68 | 69 | ### 0.2.1 70 | 71 | Contributions by Matthew Davidson, Ryan Smith 72 | 73 | * Fixed bug in `go-off-executor` macro with fully-qualified class name 74 | 75 | ### 0.2.0 76 | 77 | Contributions by Matthew Davidson, Ryan Smith 78 | 79 | * Add `go-off`, a `core-async`-style macro with a manifold flavor. Big thanks to Ryan Smith and Yummly for contributing this! 80 | * Switch to `bound-fn` in `let-flow` to fix bug where dynamic vars were incorrect for other threads 81 | * Modernized indentation to match current Clojure styles and fix misalignments 82 | 83 | ### 0.1.9 84 | 85 | Contributions by Erik Assum, Reynald Borer, Matthew Davidson, Alexey Kachayev, led, Dominic Monroe, Pierre-Yves Ritschard, Ryan Smith, Justin Sonntag, Zach Tellman, Luo Tian, and Philip van Heerden. 86 | 87 | * Updated docs to use cljdoc.org by default 88 | * Minor doc improvements 89 | * Bumped up dependencies to modern versions 90 | * Convert to CircleCI for testing and remove `jammin` 91 | * Set up for clj-commons 92 | * Fix bug where excessive pending takes return wrong deferred 93 | * Clean up timed-out pending takes and exposes vars to control clean-up behavior 94 | * Remove Travis CI 95 | * Allow functions passed to `time/in` to return a deferred 96 | * Make `time/in` cancellable 97 | * Extend thread-factory builder to create non-daemon threads 98 | * Prevent `let-flow` body from executing on last deferred thread 99 | * Fix bug in clock argument order 100 | * Remove `timeout` future execution if deferred completes before timeout 101 | * Fix bug using `let-flow` in `loop` 102 | 103 | ### 0.1.8 104 | 105 | Thanks to Paweł Stroiński 106 | 107 | * Fix handling of non-`Throwable` deferred errors when dereferencing 108 | 109 | ### 0.1.7 110 | 111 | Thanks to Ted Cushman, Vadim Platonov 112 | 113 | * Increase stack size in the wait-pool 114 | * Fix lifecycle bugs in `throttle`, `partition-all`, and `transform` 115 | * Change `let-flow` to wait on all deferred values, not just the ones used by the body 116 | 117 | ### 0.1.6 118 | 119 | Thanks to Vadim Platonov, Miikka Koskinen, Alex Engelberg, and Oleh Palianytsia 120 | 121 | * fix bug in `batch` 122 | * make `reduce` compatible with Clojure's `reduced` short-circuiting 123 | * make sure `catch` can match non-`Throwable` errors 124 | * allow for destructuring in `loop` 125 | * add `alt` mechanism for choosing the first of many deferreds to be realized 126 | 127 | ### 0.1.5 128 | 129 | Thanks to Tsutomu Yano and Joshua Griffith 130 | 131 | * fix bugs in `finally` and `consume` 132 | 133 | ### 0.1.4 134 | 135 | * Honor `:thread-factory` parameter in `manifold.executor`. 136 | 137 | ### 0.1.3 138 | 139 | * Target latest Dirigiste, which is no longer compiled using JDK 8 byte code. 140 | 141 | ### 0.1.2 142 | 143 | * fix lifecycle for `batch` and `throttle` when the source is a permanent stream 144 | * fix path where `manifold.stream/reduce` could fail to yield any value when the reducer function throws an exception, rather than yielding that error 145 | * add `mock-clock` and `with-clock` to `manifold.time`, to aid with testing timeouts and other wall-clock behavior 146 | * add `consume-async` method, which expects the consume callback to return a deferred that yields a boolean, rather than simply a boolean value 147 | * small corrections and clarifications to doc-strings 148 | 149 | 150 | ### 0.1.1 151 | 152 | * fix inline definition of `on-realized`, which would cause `(on-realized form a b)` to execute `form` twice 153 | * fix coercion support for `java.util.Iterator` 154 | * don't automatically coerce core.async channels to deferreds (use `(take! (->source chan))` instead) 155 | * add coercion support for Java 8 `BasicStream` and `CompletableFuture`, which can be optionally disabled 156 | * add `onto` method to `manifold.stream` to mirror the one in `manifold.deferred` 157 | * add formal, configurable execution model 158 | 159 | ### 0.1.0 160 | 161 | * initial release 162 | -------------------------------------------------------------------------------- /src/manifold/stream/core.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.stream.core 2 | {:no-doc true} 3 | (:require [manifold.utils :refer [definterface+]] 4 | [potemkin.types :refer [deftype+ defprotocol+]])) 5 | 6 | (defprotocol+ Sinkable 7 | (to-sink [_] "Provides a conversion mechanism to Manifold sinks.")) 8 | 9 | (defprotocol+ Sourceable 10 | (to-source [_] "Provides a conversion mechanism to Manifold source.")) 11 | 12 | (definterface+ IEventStream 13 | (description []) 14 | ; Is the underlying class synchronous by default? NB: async usage is still possible, but requires wrapping 15 | (isSynchronous []) 16 | (downstream []) 17 | (weakHandle [reference-queue]) 18 | (close [])) 19 | 20 | (definterface+ IEventSink 21 | (put [x blocking?]) 22 | (put [x blocking? timeout timeout-val]) 23 | (markClosed []) 24 | (isClosed []) 25 | (onClosed [callback])) 26 | 27 | (definterface+ IEventSource 28 | (take [default-val blocking?]) 29 | (take [default-val blocking? timeout timeout-val]) 30 | (markDrained []) 31 | (isDrained []) 32 | (onDrained [callback]) 33 | (connector [sink])) 34 | 35 | (definline close! 36 | "Closes an event sink, so that it can't accept any more messages." 37 | [sink] 38 | `(let [^manifold.stream.core.IEventStream x# ~sink] 39 | (.close x#))) 40 | 41 | (definline closed? 42 | "Returns true if the event sink is closed." 43 | [sink] 44 | `(.isClosed ~(with-meta sink {:tag "manifold.stream.core.IEventSink"}))) 45 | 46 | (definline drained? 47 | "Returns true if the event source is drained." 48 | [source] 49 | `(.isDrained ~(with-meta source {:tag "manifold.stream.core.IEventSource"}))) 50 | 51 | (definline weak-handle 52 | "Returns a weak reference that can be used to construct topologies of streams." 53 | [x] 54 | `(.weakHandle ~(with-meta x {:tag "manifold.stream.core.IEventStream"}) nil)) 55 | 56 | (definline synchronous? 57 | "Returns true if the underlying abstraction behaves synchronously, using thread blocking 58 | to provide backpressure." 59 | [x] 60 | `(.isSynchronous ~(with-meta x {:tag "manifold.stream.core.IEventStream"}))) 61 | 62 | (defmethod print-method IEventStream [o ^java.io.Writer w] 63 | (let [sink? (instance? IEventSink o) 64 | source? (instance? IEventSource o)] 65 | (.write w 66 | (str 67 | "<< " 68 | (cond 69 | (and source? sink?) 70 | "stream" 71 | 72 | source? 73 | "source" 74 | 75 | sink? 76 | "sink") 77 | ": " (pr-str (.description ^IEventStream o)) " >>")))) 78 | 79 | ;;; 80 | 81 | (def ^:private default-stream-impls 82 | `((meta [_#] ~'__mta) 83 | (resetMeta [_ m#] 84 | (manifold.utils/with-lock* ~'lock 85 | (set! ~'__mta m#))) 86 | (alterMeta [_ f# args#] 87 | (manifold.utils/with-lock* ~'lock 88 | (set! ~'__mta (apply f# ~'__mta args#)))) 89 | (~'downstream [this#] (manifold.stream.graph/downstream this#)) 90 | (~'weakHandle [this# ref-queue#] 91 | (manifold.utils/with-lock ~'lock 92 | (or ~'__weakHandle 93 | (set! ~'__weakHandle (java.lang.ref.WeakReference. this# ref-queue#))))) 94 | (~'close [this#]))) 95 | 96 | (def ^:private sink-params 97 | '[lock 98 | ^:volatile-mutable __mta 99 | ^:volatile-mutable __isClosed 100 | ^java.util.LinkedList __closedCallbacks 101 | ^:volatile-mutable __weakHandle 102 | ^:volatile-mutable __mta]) 103 | 104 | (def ^:private default-sink-impls 105 | `[(~'close [this#] (.markClosed this#)) 106 | (~'isClosed [this#] ~'__isClosed) 107 | (~'onClosed [this# callback#] 108 | (manifold.utils/with-lock ~'lock 109 | (if ~'__isClosed 110 | (callback#) 111 | (.add ~'__closedCallbacks callback#)))) 112 | (~'markClosed [this#] 113 | (manifold.utils/with-lock ~'lock 114 | (set! ~'__isClosed true) 115 | (manifold.utils/invoke-callbacks ~'__closedCallbacks)))]) 116 | 117 | (def ^:private source-params 118 | '[lock 119 | ^:volatile-mutable __mta 120 | ^:volatile-mutable __isDrained 121 | ^java.util.LinkedList __drainedCallbacks 122 | ^:volatile-mutable __weakHandle]) 123 | 124 | (def ^:private default-source-impls 125 | `[(~'isDrained [this#] ~'__isDrained) 126 | (~'onDrained [this# callback#] 127 | (manifold.utils/with-lock ~'lock 128 | (if ~'__isDrained 129 | (callback#) 130 | (.add ~'__drainedCallbacks callback#)))) 131 | (~'markDrained [this#] 132 | (manifold.utils/with-lock ~'lock 133 | (set! ~'__isDrained true) 134 | (manifold.utils/invoke-callbacks ~'__drainedCallbacks))) 135 | (~'connector [this# _#] nil)]) 136 | 137 | (defn- merged-body [& bodies] 138 | (let [bs (apply concat bodies)] 139 | (->> bs 140 | (map #(vector [(first %) (count (second %))] %)) 141 | (into {}) 142 | vals))) 143 | 144 | (defmacro def-source [name params & body] 145 | `(do 146 | (deftype+ ~name 147 | ~(vec (distinct (concat params source-params))) 148 | manifold.stream.core.IEventStream 149 | manifold.stream.core.IEventSource 150 | clojure.lang.IReference 151 | ~@(merged-body default-stream-impls default-source-impls body)) 152 | 153 | (defn ~(with-meta (symbol (str "->" name)) {:private true}) 154 | [~@(map #(with-meta % nil) params)] 155 | (new ~name ~@params (manifold.utils/mutex) nil false (java.util.LinkedList.) nil)))) 156 | 157 | (defmacro def-sink [name params & body] 158 | `(do 159 | (deftype+ ~name 160 | ~(vec (distinct (concat params sink-params))) 161 | manifold.stream.core.IEventStream 162 | manifold.stream.core.IEventSink 163 | clojure.lang.IReference 164 | ~@(merged-body default-stream-impls default-sink-impls body)) 165 | 166 | (defn ~(with-meta (symbol (str "->" name)) {:private true}) 167 | [~@(map #(with-meta % nil) params)] 168 | (new ~name ~@params (manifold.utils/mutex) nil false (java.util.LinkedList.) nil)))) 169 | 170 | (defmacro def-sink+source [name params & body] 171 | `(do 172 | (deftype+ ~name 173 | ~(vec (distinct (concat params source-params sink-params))) 174 | manifold.stream.core.IEventStream 175 | manifold.stream.core.IEventSink 176 | manifold.stream.core.IEventSource 177 | clojure.lang.IReference 178 | ~@(merged-body default-stream-impls default-sink-impls default-source-impls body)) 179 | 180 | (defn ~(with-meta (symbol (str "->" name)) {:private true}) 181 | [~@(map #(with-meta % nil) params)] 182 | (new ~name ~@params (manifold.utils/mutex) nil false (java.util.LinkedList.) nil false (java.util.LinkedList.))))) 183 | -------------------------------------------------------------------------------- /src/manifold/go_off.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.go-off 2 | {:author "Ryan Smith" 3 | :doc "Provides a variant of `core.async/go` that works with manifold's deferreds and streams. Utilizes core.async's state-machine generator, so core.async must be provided by consumers as a dependency." 4 | :added "0.2.0"} 5 | (:require [manifold 6 | [executor :as ex] 7 | [deferred :as d]] 8 | [clojure.core.async.impl 9 | [ioc-macros :as ioc]] 10 | [manifold.stream :as s]) 11 | (:import (manifold.stream.core IEventSource))) 12 | 13 | ;; a number of functions from `ioc-macros` moved to `runtime` in org.clojure/core.async "1.6.673" 14 | ;; since they were just moved without functionality changes, continue to support both via dynamic import 15 | (if (find-ns 'clojure.core.async.impl.runtime) 16 | (require '[clojure.core.async.impl.runtime :as async-runtime]) 17 | (require '[clojure.core.async.impl.ioc-macros :as async-runtime])) 18 | 19 | (defn ^:no-doc return-deferred [state value] 20 | (let [d (async-runtime/aget-object state async-runtime/USER-START-IDX)] 21 | (d/success! d value) 22 | d)) 23 | 24 | (defn deferred d)] 64 | (if 65 | ;; if already realized, deref value and immediately resume processing state machine 66 | (d/realized? d) 67 | (do (async-runtime/aset-all! state async-runtime/VALUE-IDX @d async-runtime/STATE-IDX blk) 68 | :recur) 69 | 70 | ;; resume processing state machine once d has been realized 71 | (do (d/on-realized d handler handler) 72 | nil)))))) 73 | 74 | (def ^:no-doc async-custom-terminators 75 | {'manifold.go-off/ (f#) 90 | (async-runtime/aset-all! async-runtime/USER-START-IDX d# 91 | async-runtime/BINDINGS-IDX captured-bindings#))] 92 | (run-state-machine-wrapped state#)))) 93 | ;; chain is8 being used to apply unwrap chain 94 | (d/chain d#))) 95 | ) 96 | 97 | (defmacro go-off 98 | "Asynchronously executes the body on manifold's default executor, returning 99 | immediately to the calling thread. Additionally, any visible calls to ` 30 133 | 134 | ) 135 | -------------------------------------------------------------------------------- /test/manifold/go_off_test.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.go-off-test 2 | (:require [clojure.test :refer :all] 3 | [manifold.go-off :refer [go-off (require '[manifold.deferred :as d]) 7 | nil 8 | 9 | > (def d (d/deferred)) 10 | #'d 11 | 12 | > (d/success! d :foo) 13 | true 14 | 15 | > @d 16 | :foo 17 | ``` 18 | 19 | However, similar to Clojure's futures, deferreds in Manifold can also represent errors. Crucially, they also allow for callbacks to be registered, rather than simply blocking on dereferencing. 20 | 21 | ```clojure 22 | > (def d (d/deferred)) 23 | #'d 24 | 25 | > (d/error! d (Exception. "boom")) 26 | true 27 | 28 | > @d 29 | Exception: boom 30 | ``` 31 | 32 | ```clojure 33 | > (def d (d/deferred)) 34 | #'d 35 | 36 | > (d/on-realized d 37 | (fn [x] (println "success!" x)) 38 | (fn [x] (println "error!" x))) 39 | << ... >> 40 | 41 | > (d/success! d :foo) 42 | success! :foo 43 | true 44 | ``` 45 | 46 | ### Composing with deferreds 47 | 48 | Callbacks are a useful building block, but they're a painful way to create asynchronous workflows. In practice, no one should ever use `on-realized`. 49 | 50 | Instead, they should use `manifold.deferred/chain`, which chains together callbacks, left to right: 51 | 52 | ```clojure 53 | > (def d (d/deferred)) 54 | #'d 55 | 56 | > (d/chain d inc inc inc #(println "x + 3 =" %)) 57 | << ... >> 58 | 59 | > (d/success! d 0) 60 | x + 3 = 3 61 | true 62 | ``` 63 | 64 | `chain` returns a deferred representing the return value of the right-most callback. If any of the functions returns a deferred or a value that can be coerced into a deferred, the chain will be paused until the deferred yields a value. 65 | 66 | Values that can be coerced into a deferred include Clojure futures, Java futures, and Clojure promises. 67 | 68 | ```clojure 69 | > (def d (d/deferred)) 70 | #'d 71 | 72 | > (d/chain d 73 | #(future (inc %)) 74 | #(println "the future returned" %)) 75 | << ... >> 76 | 77 | > (d/success! d 0) 78 | the future returned 1 79 | true 80 | ``` 81 | 82 | If any stage in `chain` throws an exception or returns a deferred that yields an error, all subsequent stages are skipped, and the deferred returned by `chain` yields that same error. To handle these cases, you can use `manifold.deferred/catch`: 83 | 84 | ```clojure 85 | > (def d (d/deferred)) 86 | #p 87 | 88 | > (-> d 89 | (d/chain dec #(/ 1 %)) 90 | (d/catch Exception #(println "whoops, that didn't work:" %))) 91 | << ... >> 92 | 93 | > (d/success! d 1) 94 | whoops, that didn't work: #error {:cause Divide by zero :via [{:type java.lang.ArithmeticException ... 95 | true 96 | ``` 97 | 98 | Using the `->` threading operator, `chain` and `catch` can be easily and arbitrarily composed. 99 | 100 | To combine multiple deferrable values into a single deferred that yields all their results, we can use `manifold.deferred/zip`: 101 | 102 | ```clojure 103 | > @(d/zip (future 1) (future 2) (future 3)) 104 | (1 2 3) 105 | ``` 106 | 107 | Finally, we can use `manifold.deferred/timeout!` to register a timeout on the deferred which will yield either a specified timeout value or a `TimeoutException` if the deferred is not realized within `n` milliseconds. 108 | 109 | ```clojure 110 | > @(d/timeout! 111 | (d/future (Thread/sleep 1000) :foo) 112 | 100 113 | :bar) 114 | :bar 115 | ``` 116 | 117 | Note that if a timeout is placed on a deferred returned by `chain`, the timeout elapsing will prevent any further stages from being executed. 118 | 119 | ### `future` vs `manifold.deferred/future` 120 | 121 | Clojure's futures can be treated as deferreds, as can Clojure's promises. However, since both of these abstractions use a blocking dereference, in order for Manifold to treat it as an asynchronous deferred value it must allocate a thread. 122 | 123 | Wherever possible, use `manifold.deferred/deferred` instead of `promise`, and `manifold.deferred/future` instead of `future`. They will behave identically to their Clojure counterparts (`deliver` can be used on a Manifold deferred, for instance), but allow for callbacks to be registered, so no additional threads are required. 124 | 125 | ### let-flow 126 | 127 | Let's say that we have two services which provide us numbers, and want to get their sum. By using `zip` and `chain` together, this is relatively straightforward: 128 | 129 | ```clojure 130 | (defn deferred-sum [] 131 | (let [a (call-service-a) 132 | b (call-service-b)] 133 | (chain (zip a b) 134 | (fn [[a b]] 135 | (+ a b))))) 136 | ``` 137 | 138 | However, this isn't a very direct expression of what we're doing. For more complex relationships between deferred values, our code will become even more difficult to understand. In these cases, it's often best to use `let-flow`. 139 | 140 | ```clojure 141 | (defn deferred-sum [] 142 | (let-flow [a (call-service-a) 143 | b (call-service-b)] 144 | (+ a b))) 145 | ``` 146 | 147 | In `let-flow`, we can treat deferred values as if they're realized. This is only true of values declared within or closed over by `let-flow`, however. So we can do this: 148 | 149 | ```clojure 150 | (let [a (future 1)] 151 | (let-flow [b (future (+ a 1)) 152 | c (+ b 1)] 153 | (+ c 1))) 154 | ``` 155 | 156 | but not this: 157 | 158 | ```clojure 159 | (let-flow [a (future 1) 160 | b (let [c (future 1)] 161 | (+ a c))] 162 | (+ b 1)) 163 | ``` 164 | 165 | In this example, `c` is declared within a normal `let` binding, and as such we can't treat it as if it were realized. 166 | 167 | It can be helpful to think of `let-flow` as similar to Prismatic's [Graph](https://github.com/prismatic/plumbing#graph-the-functional-swiss-army-knife) library, except that the dependencies between values are inferred from the code, rather than explicitly specified. Comparisons to core.async's goroutines are less accurate, since `let-flow` allows for concurrent execution of independent paths within the bindings, whereas operations within a goroutine are inherently sequential. 168 | 169 | ### go-off 170 | 171 | An alternate way to write code using deferreds is the macro `manifold.go-off/go-off`. This macro is an almost-exact mirror of the `go` macro from [core.async](https://github.com/clojure/core.async), to the point where it actually utilizes the state machine functionality from core.async. In order to use this macro, `core.async` must be provided as a dependency by the user. 172 | 173 | There are a few major differences between `go` and `go-off`. First, `go-off` (unsurprisingly) works with Manifold deferreds and streams instead of core.async channels. Second, in addition to the `!` equivalent in `go-off`, as there's no way without altering the syntax to distinguish between success and error when putting into a deferred. 174 | 175 | The benefit of `go-off` over `let-flow` is that it gives complete control of when deferreds should be realized to the user, removing any potential surprises (especially around timeouts). 176 | 177 | ```clojure 178 | ;; basic usage 179 | @(go-off (+ ( (require '[manifold.stream :as s]) 7 | nil 8 | > (def s (s/stream)) 9 | #'s 10 | ``` 11 | 12 | A stream can be thought of as two separate halves: a **sink** which consumes messages, and a **source** which produces them. We can `put!` messages into the sink, and `take!` them from the source: 13 | 14 | ```clojure 15 | > (s/put! s 1) 16 | << ... >> 17 | > (s/take! s) 18 | << 1 >> 19 | ``` 20 | 21 | Notice that both `put!` and `take!` return [deferred values](/doc/deferred.md). The deferred returned by `put!` will yield `true` if the message was accepted by the stream, and `false` otherwise; the deferred returned by `take!` will yield the message. 22 | 23 | Sinks can be **closed** by calling `close!`, which means they will no longer accept messages. 24 | 25 | ```clojure 26 | > (s/close! s) 27 | nil 28 | > @(s/put! s 1) 29 | false 30 | ``` 31 | 32 | We can check if a sink is closed by calling `closed?`, and register a no-arg callback using `on-closed` to be notified when the sink is closed. 33 | 34 | Sources that will never produce any more messages (often because the corresponding sink is closed) are said to be **drained**. We may check whether a source is drained via `drained?` and register callbacks with `on-drained`. 35 | 36 | By default, calling `take!` on a drained source will yield a message of `nil`. However, if `nil` is a valid message, we may want to specify some other return value to denote that the source is drained: 37 | 38 | ```clojure 39 | > @(s/take! s ::drained) 40 | ::drained 41 | ``` 42 | 43 | We may also want to put a time limit on how long we're willing to wait on our put or take to complete. For this, we can use `try-put!` and `try-take!`: 44 | 45 | ```clojure 46 | > (def s (s/stream)) 47 | #'s 48 | > @(s/try-put! s :foo 1000 ::timeout) 49 | ::timeout 50 | ``` 51 | 52 | Here we try to put a message into the stream, but since there are no consumers, it will fail after waiting for 1000ms. Here we've specified `::timeout` as our special timeout value, otherwise it would simply return `false`. 53 | 54 | ```clojure 55 | > @(s/try-take! s ::drained 1000 ::timeout) 56 | ::timeout 57 | ``` 58 | 59 | Again, we specify the timeout and special timeout value. When using `try-take!`, we must specify return values for both the drained and timeout outcomes. 60 | 61 | ### Stream operators 62 | 63 | The simplest thing we can do with a stream is consume every message that comes into it: 64 | 65 | ```clojure 66 | > (s/consume #(prn 'message! %) s) 67 | nil 68 | > @(s/put! s 1) 69 | message! 1 70 | true 71 | ``` 72 | 73 | However, we can also create derivative streams using operators analogous to Clojure's sequence operators, a full list of which [can be found here](https://cljdoc.org/d/manifold/manifold). 74 | 75 | ```clojure 76 | > (->> [1 2 3] 77 | s/->source 78 | (s/map inc) 79 | s/stream->seq) 80 | (2 3 4) 81 | ``` 82 | 83 | Here, we've mapped `inc` over a stream, transforming from a sequence to a stream and then back to a sequence for the sake of a concise example. Note that calling `manifold.stream/map` on a sequence will automatically call `->source`, so we can actually omit that, leaving just: 84 | 85 | ```clojure 86 | > (->> [1 2 3] 87 | (s/map inc) 88 | s/stream->seq) 89 | (2 3 4) 90 | ``` 91 | 92 | Since streams are not immutable, in order to treat it as a sequence we must do an explicit transformation via `stream->seq`: 93 | 94 | ```clojure 95 | > (->> [1 2 3] 96 | s/->source 97 | s/stream->seq 98 | (map inc)) 99 | (2 3 4) 100 | ``` 101 | 102 | Note that we can create multiple derived streams from the same source: 103 | 104 | ```clojure 105 | > (def s (s/stream)) 106 | #'s 107 | > (def a (s/map inc s)) 108 | #'a 109 | > (def b (s/map dec s)) 110 | #'b 111 | > @(s/put! s 0) 112 | true 113 | > @(s/take! a) 114 | 1 115 | > @(s/take! b) 116 | -1 117 | ``` 118 | 119 | Here, we create a source stream `s`, and map `inc` and `dec` over it. When we put our message into `s` it immediately is accepted, since `a` and `b` are downstream. All messages put into `s` will be propagated into *both* `a` and `b`. 120 | 121 | If `s` is closed, both `a` and `b` will be closed, as will any other downstream sources we've created. Likewise, if everything downstream of `s` is closed, `s` will also be closed, once it's unable to `put!` anywhere. This is almost always desirable, as failing to do this will simply cause `s` to exert backpressure on everything upstream of it. However, if we wish to avoid this behavior, we can create a stream using `stream*` and `:permanent? true`, which cannot be closed. 122 | 123 | For any Clojure operation that doesn't have an equivalent in `manifold.stream`, we can use `manifold.stream/transform` with a transducer: 124 | 125 | ```clojure 126 | > (->> [1 2 3] 127 | (s/transform (map inc)) 128 | s/stream->seq) 129 | (2 3 4) 130 | ``` 131 | 132 | There's also `(periodically period f)`, which behaves like `(repeatedly f)`, but will emit the result of `(f)` every `period` milliseconds. 133 | 134 | 135 | ### Connecting streams 136 | 137 | Having created an event source through composition of operators, we will often want to feed all messages into a sink. This can be accomplished via `connect`: 138 | 139 | ```clojure 140 | > (def a (s/stream)) 141 | #'a 142 | > (def b (s/stream)) 143 | #'b 144 | > (s/connect a b) 145 | true 146 | > @(s/put! a 1) 147 | true 148 | > @(s/take! b) 149 | 1 150 | ``` 151 | 152 | Again, we see that our message is immediately accepted into `a`, and can be read from `b`. We may also pass an options map into `connect`, with any of the following keys: 153 | 154 | | Field | Description | 155 | |-------|-------------| 156 | | `downstream?` | whether the source closing will close the sink, defaults to `true` | 157 | | `upstream?` | whether the sink closing will close the source, *even if there are other sinks downstream of the source*, defaults to `false` | 158 | | `timeout` | the maximum time that will be spent waiting to convey a message into the sink before the connection is severed, defaults to `nil` | 159 | | `description` | a description of the connection between the source and sink, useful for introspection purposes | 160 | 161 | After connecting two streams, we can inspect any of the streams using `description`, and follow the flow of data using `downstream`: 162 | 163 | ```clojure 164 | > (def a (s/stream)) 165 | #'a 166 | > (def b (s/stream)) 167 | #'b 168 | > (s/connect a b {:description "a connection"}) 169 | nil 170 | > (s/description a) 171 | {:pending-puts 0, :drained? false, :buffer-size 0, :permanent? false, ...} 172 | > (s/downstream a) 173 | (["a connection" << stream: ... >>]) 174 | ``` 175 | 176 | We can recursively apply `downstream` to traverse the entire topology of our streams. This can be a powerful way to reason about the structure of our running processes. 177 | 178 | Sometimes we want to change the message from the source before it's placed into the sink. For this, we can use `connect-via`: 179 | 180 | ```clojure 181 | > (def a (s/stream)) 182 | #'a 183 | > (def b (s/stream)) 184 | #'b 185 | > (s/connect-via a #(s/put! b (inc %)) b) 186 | nil 187 | ``` 188 | 189 | Note that `connect-via` takes an argument between the source and sink, which is a single-argument callback. This callback will be invoked with messages from the source, under the assumption that they will be propagated to the sink. This is the underlying mechanism for `map`, `filter`, and other stream operators; it allow us to create complex operations that are visible via `downstream`: 190 | 191 | ```clojure 192 | > (def a (s/stream)) 193 | #'a 194 | > (s/map inc a) 195 | << source: ... >> 196 | > (s/downstream a) 197 | ([{:op "map"} << sink: {:type "callback"} >>]) 198 | ``` 199 | 200 | Each element returned by `downstream` is a 2-tuple, the first element describing the connection, and the second element describing the stream it's feeding into. 201 | 202 | The value returned by the callback for `connect-via` provides backpressure - if a deferred value is returned, further messages will not be passed in until the deferred value is realized. 203 | 204 | ### Buffers and backpressure 205 | 206 | We saw above that if we attempt to put a message into a stream, it won't succeed until the value is taken out. This is because the default stream has no buffer; it simply conveys messages from producers to consumers. If we want to create a stream with a buffer, we can simply call `(stream buffer-size)`. We can also call `(buffer size stream)` to create a buffer downstream of an existing stream. 207 | 208 | We may also call `(buffer metric limit stream)`, if we don't want to measure our buffer's size in messages. If, for instance, each message is a collection, we could use `count` as our metric, and set `limit` to whatever we want the maximum aggregate count to be. 209 | 210 | To limit the rate of messages from a stream, we can use `(throttle max-rate stream)`. 211 | 212 | ### Event buses and publish/subscribe models 213 | 214 | Manifold provides a simple publish/subscribe mechanism in the `manifold.bus` namespace. To create an event bus, we can use `(event-bus)`. To publish to a particular topic on that bus, we use `(publish! bus topic msg)`. To get a stream representing all messages on a topic, we can call `(subscribe bus topic)`. 215 | 216 | Calls to `publish!` will return a deferred that won't be realized until all streams have accepted the message. By default, all streams returned by `subscribe` are unbuffered, but we can change this by providing a `stream-generator` to `event-bus`, such as `(event-bus #(stream 1e3))`. A short example of how `event-bus` can be used in concert with the buffering and flow control mechanisms [can be found here](https://youtu.be/1bNOO3xxMc0?t=1887). 217 | -------------------------------------------------------------------------------- /src/manifold/time.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.time 2 | {:author "Zach Tellman" 3 | :doc "This namespace contains methods for converting units of time, with milliseconds as the base representation, and for deferring execution of functions to some time in the future. In practice, the methods here are not necessary to use Manifold effectively - `manifold.deferred/timeout` and `manifold.stream/periodically` are more directly useful - but they are available for anyone who should need them."} 4 | (:require 5 | [clojure.tools.logging :as log] 6 | [manifold.executor :as ex] 7 | [clojure.string :as str] 8 | [manifold.utils :refer [definterface+]] 9 | [potemkin.types :refer [defprotocol+]] 10 | [clj-commons.primitive-math :as p]) 11 | (:import 12 | [java.util 13 | Calendar 14 | TimeZone] 15 | [java.util.concurrent 16 | Future 17 | Executor 18 | Executors 19 | TimeUnit 20 | ScheduledExecutorService 21 | ScheduledThreadPoolExecutor 22 | TimeoutException])) 23 | 24 | (defn nanoseconds 25 | "Converts nanoseconds -> milliseconds" 26 | [^double n] 27 | (p// n 1e6)) 28 | 29 | (defn microseconds 30 | "Converts microseconds -> milliseconds" 31 | [^double n] 32 | (p// n 1e3)) 33 | 34 | (defn milliseconds 35 | "Converts milliseconds -> milliseconds" 36 | [^double n] 37 | n) 38 | 39 | (defn seconds 40 | "Converts seconds -> milliseconds" 41 | [^double n] 42 | (p/* n 1e3)) 43 | 44 | (defn minutes 45 | "Converts minutes -> milliseconds" 46 | [^double n] 47 | (p/* n 6e4)) 48 | 49 | (defn hours 50 | "Converts hours -> milliseconds" 51 | [^double n] 52 | (p/* n 36e5)) 53 | 54 | (defn days 55 | "Converts days -> milliseconds" 56 | [^double n] 57 | (p/* n 864e5)) 58 | 59 | (defn hz 60 | "Converts frequency -> period in milliseconds" 61 | [^double n] 62 | (p// 1e3 n)) 63 | 64 | (let [intervals (partition 2 ["d" (days 1) 65 | "h" (hours 1) 66 | "m" (minutes 1) 67 | "s" (seconds 1)])] 68 | 69 | (defn format-duration 70 | "Takes a duration in milliseconds, and returns a formatted string 71 | describing the interval, i.e. '5d 3h 1m'" 72 | [^double n] 73 | (loop [s "", n n, intervals intervals] 74 | (if (empty? intervals) 75 | (if (empty? s) 76 | "0s" 77 | (str/trim s)) 78 | (let [[desc ^double val] (first intervals)] 79 | (if (p/>= n val) 80 | (recur 81 | (str s (int (p// n val)) desc " ") 82 | (rem n val) 83 | (rest intervals)) 84 | (recur s n (rest intervals)))))))) 85 | 86 | (let [sorted-units [:millisecond Calendar/MILLISECOND 87 | :second Calendar/SECOND 88 | :minute Calendar/MINUTE 89 | :hour Calendar/HOUR 90 | :day Calendar/DAY_OF_YEAR 91 | :week Calendar/WEEK_OF_MONTH 92 | :month Calendar/MONTH] 93 | unit->calendar-unit (apply hash-map sorted-units) 94 | units (->> sorted-units (partition 2) (map first)) 95 | unit->cleared-fields (zipmap 96 | units 97 | (map 98 | #(->> (take % units) (map unit->calendar-unit)) 99 | (range (count units))))] 100 | 101 | (defn floor 102 | "Takes a `timestamp`, and rounds it down to the nearest even multiple of the `unit`. 103 | 104 | (floor 1001 :second) => 1000 105 | (floor (seconds 61) :minute) => 60000 106 | 107 | " 108 | [timestamp unit] 109 | (assert (contains? unit->calendar-unit unit)) 110 | (let [^Calendar cal (doto (Calendar/getInstance (TimeZone/getTimeZone "UTC")) 111 | (.setTimeInMillis timestamp))] 112 | (doseq [field (unit->cleared-fields unit)] 113 | (.set cal field 0)) 114 | (.getTimeInMillis cal))) 115 | 116 | (defn add 117 | "Takes a `timestamp`, and adds `value` multiples of `unit` to the value." 118 | [timestamp value unit] 119 | (assert (contains? unit->calendar-unit unit)) 120 | (let [^Calendar cal (doto (Calendar/getInstance (TimeZone/getTimeZone "UTC")) 121 | (.setTimeInMillis timestamp))] 122 | (.add cal (unit->calendar-unit unit) value) 123 | (.getTimeInMillis cal)))) 124 | 125 | ;;; 126 | 127 | (in-ns 'manifold.deferred) 128 | (clojure.core/declare success! error! deferred realized? chain connect on-realized) 129 | (in-ns 'manifold.time) 130 | 131 | ;;; 132 | 133 | (definterface+ IClock 134 | (in [^double interval-millis ^Runnable f]) 135 | (every [^double delay-millis ^double period-millis ^Runnable f])) 136 | 137 | (defprotocol+ IMockClock 138 | (now [clock] "Returns the current time for the clock") 139 | (advance [clock time] 140 | "Advances the mock clock by the specified interval of `time`. 141 | 142 | Advancing the clock is a continuous action - the clock doesn't just jump 143 | from `now` to `new-now = (+ (now clock) time)`. Rather, for each scheduled 144 | event within `[now; new-now]` the clock is reset to the time of the event 145 | and the event function is executed. 146 | 147 | For example, if you have a periodic function scheduled with 148 | 149 | (every 1 #(swap! counter inc)) 150 | 151 | and advance the clock by 5, the counter will be incremented 6 times in 152 | total: once initially, as the initial delay is 0 and 5 times for every 1 ms 153 | step of the clock.")) 154 | 155 | (defn- cancel-on-exception [f cancel-fn] 156 | (fn [] 157 | (try (f) 158 | (catch Throwable t 159 | (cancel-fn) 160 | (throw t))))) 161 | 162 | (defn scheduled-executor->clock [^ScheduledExecutorService e] 163 | (reify IClock 164 | (in [_ interval-millis f] 165 | (let [^Future scheduled-future (.schedule e f (p/long (p/* interval-millis 1e3)) TimeUnit/MICROSECONDS) 166 | cancel-fn (fn [] 167 | (.cancel scheduled-future false))] 168 | cancel-fn)) 169 | (every [_ delay-millis period-millis f] 170 | (let [future-ref (promise) 171 | cancel-fn (fn [] 172 | (let [^Future future @future-ref] 173 | (.cancel future false)))] 174 | (deliver future-ref 175 | (.scheduleAtFixedRate e 176 | ^Runnable (cancel-on-exception f cancel-fn) 177 | (p/long (p/* delay-millis 1e3)) 178 | (p/long (p/* period-millis 1e3)) 179 | TimeUnit/MICROSECONDS)) 180 | cancel-fn)))) 181 | 182 | (defn mock-clock 183 | "Creates a clock designed for testing scheduled behaviors. It can replace the default 184 | scheduler using `with-clock`, and can be advanced to a particular time via `advance`. By 185 | default, the initial time is `0`." 186 | ([] 187 | (mock-clock 0)) 188 | ([^double initial-time] 189 | (let [now (atom initial-time) 190 | events (atom (sorted-map))] 191 | (reify 192 | IClock 193 | (in [this interval-millis f] 194 | (let [t (p/+ ^double @now interval-millis) 195 | cancel-fn (fn [] 196 | (swap! events #(cond-> % 197 | (contains? % t) 198 | (update t disj f))))] 199 | (swap! events update t (fnil conj #{}) f) 200 | (advance this 0) 201 | cancel-fn)) 202 | (every [this delay-millis period-millis f] 203 | (assert (p/< 0.0 period-millis)) 204 | (let [period (atom period-millis) 205 | cancel-fn #(reset! period -1)] 206 | (->> (with-meta (cancel-on-exception f cancel-fn) {::period period}) 207 | (.in this (p/max 0.0 delay-millis))) 208 | cancel-fn)) 209 | 210 | IMockClock 211 | (now [_] @now) 212 | (advance 213 | [this time] 214 | (let [limit (+ ^double @now ^double time)] 215 | (loop [] 216 | (if (or (empty? @events) 217 | (p/< limit ^double (key (first @events)))) 218 | (do 219 | (reset! now limit) 220 | nil) 221 | 222 | (let [[t fs] (first @events)] 223 | (swap! events dissoc t) 224 | (reset! now t) 225 | (doseq [f fs] 226 | (let [period (some-> f meta ::period deref)] 227 | (when (or (nil? period) (p/< 0.0 ^double period)) 228 | (try 229 | (f) 230 | (when period (.in this period f)) 231 | (catch Throwable e 232 | (log/debug e "error in mock clock")))))) 233 | (recur)))))))))) 234 | 235 | (let [num-cores (.availableProcessors (Runtime/getRuntime)) 236 | cnt (atom 0) 237 | clock (delay 238 | (scheduled-executor->clock 239 | (doto (ScheduledThreadPoolExecutor. 240 | 1 241 | (ex/thread-factory 242 | (fn [] 243 | (str "manifold-scheduler-pool-" (swap! cnt inc))) 244 | (deliver (promise) nil))) 245 | (.setRemoveOnCancelPolicy true))))] 246 | (def ^:dynamic ^IClock *clock* 247 | (reify IClock 248 | (in [_ interval f] (.in ^IClock @clock interval f)) 249 | (every [_ delay period f] (.every ^IClock @clock delay period f))))) 250 | 251 | (defmacro with-clock 252 | "Ensures that all calls to `every` and `in` are made through the specified clock, rather 253 | than the default one." 254 | [clock & body] 255 | `(binding [*clock* ~clock] 256 | ~@body)) 257 | 258 | (defn in 259 | "Schedules no-arg function `f` to be invoked in `interval` milliseconds. Returns a deferred 260 | representing the returned value of the function (unwrapped if `f` itself returns a deferred). 261 | If the returned deferred is completed before the interval has passed, the timeout function 262 | will be cancelled." 263 | [^double interval f] 264 | (let [d (manifold.deferred/deferred) 265 | f (fn [] 266 | (when-not (manifold.deferred/realized? d) 267 | (try 268 | (manifold.deferred/connect (f) d) 269 | (catch Throwable e 270 | (manifold.deferred/error! d e))))) 271 | cancel-fn (.in *clock* interval f)] 272 | (manifold.deferred/on-realized d 273 | (fn [_] (cancel-fn)) 274 | (fn [_] (cancel-fn))) 275 | d)) 276 | 277 | (defn every 278 | "Schedules no-arg function `f` to be invoked every `period` milliseconds, after `initial-delay` 279 | milliseconds, which defaults to `0`. Returns a zero-argument function which, when invoked, 280 | cancels the repeated invocation. 281 | 282 | If the invocation of `f` ever throws an exception, repeated invocation is automatically 283 | cancelled." 284 | ([period f] 285 | (every period 0 f)) 286 | ([period initial-delay f] 287 | (.every *clock* initial-delay period f))) 288 | 289 | (defn at 290 | "Schedules no-arg function `f` to be invoked at `timestamp`, which is the milliseconds 291 | since the epoch. Returns a deferred representing the returned value of the function 292 | (unwrapped if `f` itself returns a deferred)." 293 | [^long timestamp f] 294 | (in (p/max 0 (p/- timestamp (System/currentTimeMillis))) f)) 295 | -------------------------------------------------------------------------------- /src/manifold/executor.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.executor 2 | (:require 3 | [clojure.tools.logging :as log] 4 | [clj-commons.primitive-math :as p]) 5 | (:import 6 | [io.aleph.dirigiste 7 | Executors 8 | Executor 9 | Executor$Controller 10 | Stats 11 | Stats$Metric] 12 | [java.util 13 | EnumSet] 14 | [java.util.concurrent 15 | SynchronousQueue 16 | LinkedBlockingQueue 17 | ArrayBlockingQueue 18 | ThreadFactory 19 | TimeUnit])) 20 | 21 | ;;; 22 | 23 | (def ^ThreadLocal executor-thread-local (ThreadLocal.)) 24 | 25 | (definline executor [] 26 | `(.get manifold.executor/executor-thread-local)) 27 | 28 | (defmacro with-executor [executor & body] 29 | `(let [executor# (executor)] 30 | (.set executor-thread-local ~executor) 31 | (try 32 | ~@body 33 | (finally 34 | (.set executor-thread-local executor#))))) 35 | 36 | (defn- ^Thread new-thread 37 | "Creates a new `java.lang.Thread`. 38 | 39 | It represents the default implementation on `thread-factory` when the 40 | `new-thread-fn` argument is not passed. 41 | 42 | Some libraries require a different implementation of a `java.lang.Thread`. 43 | That's the case of Netty which behaves differently when 44 | running on a `io.netty.util.concurrent.FastThreadLocalThread`." 45 | [group target name stack-size] 46 | (Thread. group target name stack-size)) 47 | 48 | (defn ^ThreadFactory thread-factory 49 | "Returns a `java.util.concurrent.ThreadFactory`. 50 | 51 | |:---|:---- 52 | | `name-generator` | a zero-argument function, which, when invoked returns the name of the `java.lang.Thread` that will be created. | 53 | | `executor-promise` | a promise eventually containing a `java.util.concurrent.Executor` that will be stored on `manifold.executor/executor-thread-local`. | 54 | | `stack-size` | the desired stack size for the new thread, or nil/zero to indicate that this parameter is to be ignored. | 55 | | `daemon?` | marks the created threads as either daemon or user threads. The Java Virtual Machine exits when the only threads running are all daemon threads. | 56 | | `new-thread-fn` | a four arguments function which returns an implementation of `java.lang.Thread` when called. |" 57 | ([name-generator executor-promise] 58 | (thread-factory name-generator executor-promise nil true nil)) 59 | ([name-generator executor-promise stack-size] 60 | (thread-factory name-generator executor-promise stack-size true nil)) 61 | ([name-generator executor-promise stack-size daemon?] 62 | (thread-factory name-generator executor-promise stack-size daemon? nil)) 63 | ([name-generator executor-promise stack-size daemon? new-thread-fn] 64 | (let [new-thread (or new-thread-fn new-thread)] 65 | (reify ThreadFactory 66 | (newThread [_ runnable] 67 | (let [name (name-generator) 68 | curr-loader (.getClassLoader (class thread-factory)) 69 | f #(do 70 | (.set executor-thread-local @executor-promise) 71 | (.run ^Runnable runnable)) 72 | thread ^Thread (new-thread nil f name (or stack-size 0))] 73 | (doto thread 74 | (.setDaemon daemon?) 75 | (.setContextClassLoader curr-loader)))))))) 76 | 77 | ;;; 78 | 79 | (defn stats->map 80 | "Converts a Dirigiste `Stats` object into a map of values onto quantiles." 81 | ([s] 82 | (stats->map s [0.5 0.9 0.95 0.99 0.999])) 83 | ([^Stats s quantiles] 84 | (let [stats (.getMetrics s) 85 | q #(zipmap quantiles (mapv % quantiles))] 86 | (merge 87 | {:num-workers (.getNumWorkers s)} 88 | (when (contains? stats Stats$Metric/QUEUE_LENGTH) 89 | {:queue-length (q #(.getQueueLength s %))}) 90 | (when (contains? stats Stats$Metric/QUEUE_LATENCY) 91 | {:queue-latency (q #(p/double (p// (.getQueueLatency s %) 1e6)))}) 92 | (when (contains? stats Stats$Metric/TASK_LATENCY) 93 | {:task-latency (q #(p/double (p// (.getTaskLatency s %) 1e6)))}) 94 | (when (contains? stats Stats$Metric/TASK_ARRIVAL_RATE) 95 | {:task-arrival-rate (q #(.getTaskArrivalRate s %))}) 96 | (when (contains? stats Stats$Metric/TASK_COMPLETION_RATE) 97 | {:task-completion-rate (q #(.getTaskCompletionRate s %))}) 98 | (when (contains? stats Stats$Metric/TASK_REJECTION_RATE) 99 | {:task-rejection-rate (q #(.getTaskRejectionRate s %))}) 100 | (when (contains? stats Stats$Metric/UTILIZATION) 101 | {:utilization (q #(.getUtilization s %))}))))) 102 | 103 | (def ^:private factory-count (atom 0)) 104 | 105 | (defn instrumented-executor 106 | "Returns a `java.util.concurrent.ExecutorService`, using [Dirigiste](https://github.com/ztellman/dirigiste). 107 | 108 | |:---|:---- 109 | | `thread-factory` | an optional `java.util.concurrent.ThreadFactory` that creates the executor's threads. | 110 | | `queue-length` | the maximum number of pending tasks before `.execute()` begins throwing `java.util.concurrent.RejectedExecutionException`, defaults to `0`. 111 | | `stats-callback` | a function that will be invoked every `control-period` with the relevant statistics for the executor. 112 | | `sample-period` | the interval, in milliseconds, between sampling the state of the executor for resizing and gathering statistics, defaults to `25`. 113 | | `control-period` | the interval, in milliseconds, between use of the controller to adjust the size of the executor, defaults to `10000`. 114 | | `controller` | the Dirigiste controller that is used to guide the pool's size. 115 | | `metrics` | an `EnumSet` of the metrics that should be gathered for the controller, defaults to all. 116 | | `initial-thread-count` | the number of threads that the pool should begin with. 117 | | `onto?` | if true, all streams and deferred generated in the scope of this executor will also be 'on' this executor." 118 | [{:keys [thread-factory 119 | ^long queue-length 120 | stats-callback 121 | sample-period 122 | control-period 123 | controller 124 | metrics 125 | initial-thread-count 126 | onto?] 127 | :or {initial-thread-count 1 128 | sample-period 25 129 | control-period 10000 130 | metrics (EnumSet/allOf Stats$Metric) 131 | onto? true}}] 132 | (let [executor-promise (promise) 133 | thread-count (atom 0) 134 | factory (swap! factory-count inc) 135 | thread-factory (if thread-factory 136 | thread-factory 137 | (manifold.executor/thread-factory 138 | #(str "manifold-pool-" factory "-" (swap! thread-count inc)) 139 | (if onto? 140 | executor-promise 141 | (deliver (promise) nil)))) 142 | ^Executor$Controller c controller 143 | metrics (if (identical? :none metrics) 144 | (EnumSet/noneOf Stats$Metric) 145 | metrics)] 146 | (assert controller "must specify :controller") 147 | @(deliver executor-promise 148 | (Executor. 149 | thread-factory 150 | (if (and queue-length (pos? queue-length)) 151 | (if (p/<= queue-length 1024) 152 | (ArrayBlockingQueue. queue-length false) 153 | (LinkedBlockingQueue. (int queue-length))) 154 | (SynchronousQueue. false)) 155 | (if stats-callback 156 | (reify Executor$Controller 157 | (shouldIncrement [_ n] 158 | (.shouldIncrement c n)) 159 | (adjustment [_ s] 160 | (stats-callback (stats->map s)) 161 | (.adjustment c s))) 162 | c) 163 | initial-thread-count 164 | metrics 165 | sample-period 166 | control-period 167 | TimeUnit/MILLISECONDS)))) 168 | 169 | (defn fixed-thread-executor 170 | "Returns an executor which has a fixed number of threads." 171 | ([num-threads] 172 | (fixed-thread-executor num-threads nil)) 173 | ([^long num-threads options] 174 | (instrumented-executor 175 | (-> options 176 | (update-in [:queue-length] #(or % Integer/MAX_VALUE)) 177 | (assoc 178 | :max-threads num-threads 179 | :controller (reify Executor$Controller 180 | (shouldIncrement [_ n] 181 | (p/< n num-threads)) 182 | (adjustment [_ s] 183 | (p/- num-threads (.getNumWorkers s))))))))) 184 | 185 | (defn utilization-executor 186 | "Returns an executor which sizes the thread pool according to target utilization, within 187 | `[0,1]`, up to `max-threads`. The `queue-length` for this executor is always `0`, and by 188 | default has an unbounded number of threads." 189 | ([utilization] 190 | (utilization-executor utilization Integer/MAX_VALUE nil)) 191 | ([utilization max-threads] 192 | (utilization-executor utilization max-threads nil)) 193 | ([utilization max-threads options] 194 | (instrumented-executor 195 | (assoc options 196 | :queue-length 0 197 | :max-threads max-threads 198 | :controller (Executors/utilizationController utilization max-threads))))) 199 | 200 | ;;; 201 | 202 | (def ^:private wait-pool-stats-callbacks (atom #{})) 203 | 204 | (defn register-wait-pool-stats-callback 205 | "Registers a callback which will be called with wait-pool stats." 206 | [c] 207 | (swap! wait-pool-stats-callbacks conj c)) 208 | 209 | (defn unregister-wait-pool-stats-callback 210 | "Unregisters a previous wait-pool stats callback." 211 | [c] 212 | (swap! wait-pool-stats-callbacks disj c)) 213 | 214 | (let [wait-pool-promise 215 | (delay 216 | (let [cnt (atom 0)] 217 | (utilization-executor 0.95 Integer/MAX_VALUE 218 | {:thread-factory (thread-factory 219 | #(str "manifold-wait-" (swap! cnt inc)) 220 | (deliver (promise) nil)) 221 | :stats-callback (fn [stats] 222 | (doseq [f @wait-pool-stats-callbacks] 223 | (try 224 | (f stats) 225 | (catch Throwable e 226 | (log/error e "error in wait-pool stats callback")))))})))] 227 | (defn wait-pool [] 228 | @wait-pool-promise)) 229 | 230 | ;;; 231 | 232 | (def ^:private execute-pool-stats-callbacks (atom #{})) 233 | 234 | (defn register-execute-pool-stats-callback 235 | "Registers a callback which will be called with execute-pool stats." 236 | [c] 237 | (swap! execute-pool-stats-callbacks conj c)) 238 | 239 | (defn unregister-execute-pool-stats-callback 240 | "Unregisters a previous execute-pool stats callback." 241 | [c] 242 | (swap! execute-pool-stats-callbacks disj c)) 243 | 244 | (let [execute-pool-promise 245 | (delay 246 | (let [cnt (atom 0)] 247 | (utilization-executor 0.95 Integer/MAX_VALUE 248 | {:thread-factory (thread-factory 249 | #(str "manifold-execute-" (swap! cnt inc)) 250 | (deliver (promise) nil)) 251 | :stats-callback (fn [stats] 252 | (doseq [f @execute-pool-stats-callbacks] 253 | (try 254 | (f stats) 255 | (catch Throwable e 256 | (log/error e "error in execute-pool stats callback")))))})))] 257 | (defn execute-pool [] 258 | @execute-pool-promise)) 259 | -------------------------------------------------------------------------------- /src/manifold/stream/default.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.stream.default 2 | {:no-doc true} 3 | (:require 4 | [clojure.tools.logging :as log] 5 | [manifold 6 | [deferred :as d] 7 | [utils :as utils] 8 | [executor :as ex]] 9 | [manifold.stream 10 | [graph :as g] 11 | [core :as s]] 12 | [manifold.time :as time] 13 | [potemkin.types :refer [deftype+ defrecord+]] 14 | [clj-commons.primitive-math :as p]) 15 | (:import 16 | [java.util 17 | LinkedList 18 | ArrayDeque 19 | Queue] 20 | [java.util.concurrent 21 | BlockingQueue 22 | ArrayBlockingQueue 23 | LinkedBlockingQueue] 24 | [java.util.concurrent.atomic 25 | AtomicLong])) 26 | 27 | (set! *unchecked-math* true) 28 | 29 | ;;; 30 | 31 | (def max-dirty-takes "Every X takes, scan for timed-out deferreds and remove" 64) 32 | (def max-dirty-puts "Every X puts, scan for timed-out deferreds and remove" 64) 33 | (def max-consumers "Maximum number of pending consumers" 16384) 34 | (def max-producers "Maximum number of pending producers" 16384) 35 | 36 | (deftype+ Production [deferred message token]) 37 | (deftype+ Consumption [message deferred token]) 38 | (defrecord+ Producer [message deferred]) 39 | (defrecord+ Consumer [deferred default-val]) 40 | 41 | (defn de-nil [x] 42 | (if (nil? x) 43 | ::nil 44 | x)) 45 | 46 | (defn re-nil [x] 47 | (if (identical? ::nil x) 48 | nil 49 | x)) 50 | 51 | (defn- cleanup-expired-deferreds 52 | "Removes all realized deferreds (presumably from timing out)." 53 | [^LinkedList l] 54 | (locking l 55 | (when-not (.isEmpty l) 56 | (let [iter (.iterator l)] 57 | (loop [c (.next iter)] 58 | (when (-> c :deferred d/realized?) 59 | (.remove iter)) 60 | (when (.hasNext iter) 61 | (recur (.next iter)))))))) 62 | 63 | (s/def-sink+source Stream 64 | [^boolean permanent? 65 | description 66 | ^LinkedList producers 67 | ^LinkedList consumers 68 | ^long capacity 69 | ^Queue messages 70 | executor 71 | add! 72 | ^AtomicLong dirty-takes] 73 | 74 | (isSynchronous [_] false) 75 | 76 | (description [this] 77 | (let [m {:type "manifold" 78 | :sink? true 79 | :source? true 80 | :pending-puts (.size producers) 81 | :buffer-capacity capacity 82 | :buffer-size (if messages (.size messages) 0) 83 | :pending-takes (.size consumers) 84 | :permanent? permanent? 85 | :closed? (s/closed? this) 86 | :drained? (s/drained? this)}] 87 | (if description 88 | (description m) 89 | m))) 90 | 91 | (close [this] 92 | (when-not permanent? 93 | (utils/with-lock lock 94 | (when-not (s/closed? this) 95 | 96 | (try 97 | (let [acc (LinkedList.) 98 | result (try 99 | (unreduced (add! acc)) 100 | (catch Throwable e 101 | (log/error e "error in stream transformer") 102 | false))] 103 | 104 | (loop [] 105 | (if-not (.isEmpty acc) 106 | (let [x (.removeFirst acc)] 107 | (cond 108 | 109 | (instance? Producer x) 110 | (log/warn (IllegalStateException.) (format "excessive pending puts (> %d) while closing stream" max-producers)) 111 | 112 | (instance? Production x) 113 | (let [^Production p x] 114 | (d/success! (.deferred p) (.message p) (.token p)) 115 | (recur)) 116 | 117 | :else 118 | (recur)))))) 119 | 120 | (catch Throwable e 121 | (log/error e "error in stream transformer"))) 122 | 123 | (loop [] 124 | (when-let [^Consumer c (.poll consumers)] 125 | (try 126 | (d/success! (.deferred c) (.default-val c)) 127 | (catch Throwable e 128 | (log/error e "error in callback"))) 129 | (recur))) 130 | 131 | (.markClosed this) 132 | 133 | (when (s/drained? this) 134 | (.markDrained this)))))) 135 | 136 | (isDrained [this] 137 | (utils/with-lock lock 138 | (and (s/closed? this) 139 | (nil? (.peek producers)) 140 | (or (nil? messages) 141 | (nil? (.peek messages)))))) 142 | 143 | (put [this msg blocking? timeout timeout-val] 144 | (let [acc (LinkedList.) 145 | 146 | result (utils/with-lock lock 147 | (try 148 | (if (.isClosed this) 149 | false 150 | (add! acc msg)) 151 | (catch Throwable e 152 | (log/error e "error in stream transformer") 153 | false))) 154 | 155 | close? (reduced? result) 156 | 157 | result (if close? 158 | @result 159 | result) 160 | 161 | val (loop [val true] 162 | (if (.isEmpty acc) 163 | val 164 | (let [x (.removeFirst acc)] 165 | (cond 166 | 167 | (instance? Producer x) 168 | (do 169 | (log/warn (IllegalStateException.) (format "excessive pending puts (> %d), closing stream" max-producers)) 170 | (s/close! this) 171 | false) 172 | 173 | (instance? Production x) 174 | (let [^Production p x] 175 | (d/success! (.deferred p) (.message p) (.token p)) 176 | (recur true)) 177 | 178 | :else 179 | (do 180 | (d/timeout! x timeout timeout-val) 181 | (recur x))))))] 182 | 183 | (cond 184 | 185 | (or close? (false? result)) 186 | (do 187 | (.close this) 188 | (d/success-deferred false executor)) 189 | 190 | (d/deferred? val) 191 | val 192 | 193 | :else 194 | (d/success-deferred val executor)))) 195 | 196 | (put [this msg blocking?] 197 | (.put this msg blocking? nil nil)) 198 | 199 | (take [this default-val blocking? timeout timeout-val] 200 | (let [result 201 | (utils/with-lock lock 202 | (or 203 | 204 | ;; see if we can dequeue from the buffer 205 | (when-let [msg (and messages (.poll messages))] 206 | (let [msg (re-nil msg)] 207 | 208 | ;; check if we're drained 209 | (when (and (s/closed? this) (s/drained? this)) 210 | (.markDrained this)) 211 | 212 | (if-let [^Producer p (.poll producers)] 213 | (if-let [token (d/claim! (.deferred p))] 214 | (do 215 | (.offer messages (de-nil (.message p))) 216 | (Consumption. msg (.deferred p) token)) 217 | (d/success-deferred msg executor)) 218 | (d/success-deferred msg executor)))) 219 | 220 | ;; see if there are any unclaimed producers left 221 | (loop [^Producer p (.poll producers)] 222 | (when p 223 | (if-let [token (d/claim! (.deferred p))] 224 | (let [c (Consumption. (.message p) (.deferred p) token)] 225 | 226 | ;; check if we're drained 227 | (when (and (s/closed? this) (s/drained? this)) 228 | (.markDrained this)) 229 | 230 | c) 231 | (recur (.poll producers))))) 232 | 233 | ;; closed, return << default-val >> 234 | (and (s/closed? this) 235 | (d/success-deferred default-val executor)) 236 | 237 | ;; add to the consumers queue 238 | (if (and timeout (p/<= ^long timeout 0)) 239 | (d/success-deferred timeout-val executor) 240 | (do 241 | (when (p/> (.getAndIncrement dirty-takes) ^long max-dirty-takes) 242 | (cleanup-expired-deferreds consumers) 243 | (.set dirty-takes 0)) 244 | (let [d (d/deferred executor)] 245 | (d/timeout! d timeout timeout-val) 246 | (let [c (Consumer. d default-val)] 247 | (if (and (p/< (.size consumers) ^long max-consumers) (.offer consumers c)) 248 | d 249 | c)))))))] 250 | 251 | (cond 252 | 253 | (instance? Consumer result) 254 | (do 255 | (log/warn (IllegalStateException.) (format "excessive pending takes (> %s), closing stream" max-consumers)) 256 | (s/close! this) 257 | (d/success-deferred default-val executor)) 258 | 259 | (instance? Consumption result) 260 | (let [^Consumption result result] 261 | (try 262 | (d/success! (.deferred result) true (.token result)) 263 | (catch Throwable e 264 | (log/error e "error in callback"))) 265 | (let [msg (re-nil (.message result))] 266 | (if blocking? 267 | msg 268 | (d/success-deferred msg executor)))) 269 | 270 | :else 271 | (if blocking? 272 | @result 273 | result)))) 274 | 275 | (take [this default-val blocking?] 276 | (.take this default-val blocking? nil nil))) 277 | 278 | (defn add! 279 | [^LinkedList producers 280 | ^LinkedList consumers 281 | ^Queue messages 282 | capacity 283 | executor 284 | ^AtomicLong dirty-puts] 285 | (let [capacity (p/long capacity) 286 | t-d (d/success-deferred true executor)] 287 | (fn 288 | ([]) 289 | ([acc] acc) 290 | ([^LinkedList acc msg] 291 | (doto acc 292 | (.add 293 | (or 294 | ;; send to all unclaimed consumers, if any 295 | (loop [^Consumer c (.poll consumers)] 296 | (when c 297 | (if-let [token (d/claim! (.deferred c))] 298 | (Production. (.deferred c) msg token) 299 | (recur (.poll consumers))))) 300 | 301 | ;; otherwise, see if we can enqueue into the buffer 302 | (and 303 | messages 304 | (when (p/< (.size messages) capacity) 305 | (.offer messages (de-nil msg))) 306 | t-d) 307 | 308 | ;; otherwise, add to the producers queue 309 | (do 310 | (when (p/> (.getAndIncrement dirty-puts) ^long max-dirty-puts) 311 | (cleanup-expired-deferreds producers) 312 | (.set dirty-puts 0)) 313 | (let [d (d/deferred executor)] 314 | (let [pr (Producer. msg d)] 315 | (if (and (p/< (.size producers) ^long max-producers) (.offer producers pr)) 316 | d 317 | pr))))))))))) 318 | 319 | (defn stream 320 | ([] 321 | (stream 0 nil (ex/executor))) 322 | ([buffer-size] 323 | (stream buffer-size nil (ex/executor))) 324 | ([buffer-size xform] 325 | (stream buffer-size xform (ex/executor))) 326 | ([buffer-size xform executor] 327 | (let [consumers (LinkedList.) 328 | producers (LinkedList.) 329 | dirty-takes (AtomicLong.) 330 | dirty-puts (AtomicLong.) 331 | buffer-size (p/long (p/max 0 (p/long buffer-size))) 332 | messages (when (p/< 0 buffer-size) (ArrayDeque.)) 333 | add! (add! producers consumers messages buffer-size executor dirty-puts) 334 | add! (if xform (xform add!) add!)] 335 | (->Stream 336 | false 337 | nil 338 | producers 339 | consumers 340 | buffer-size 341 | messages 342 | executor 343 | add! 344 | dirty-takes)))) 345 | 346 | (defn onto [ex s] 347 | (if (and (instance? Stream s) (identical? ex (.executor ^Stream s))) 348 | s 349 | (let [s' (stream 0 nil ex)] 350 | (g/connect s s' nil) 351 | s'))) 352 | 353 | (defn stream* 354 | [{:keys [permanent? 355 | buffer-size 356 | description 357 | executor 358 | xform] 359 | :or {permanent? false 360 | executor (ex/executor)}}] 361 | (let [consumers (LinkedList.) 362 | producers (LinkedList.) 363 | dirty-takes (AtomicLong.) 364 | dirty-puts (AtomicLong.) 365 | buffer-size (p/long (or buffer-size 0)) 366 | messages (when buffer-size (ArrayDeque.)) 367 | buffer-size (if buffer-size (p/long (Math/max 0 buffer-size)) 0) 368 | add! (add! producers consumers messages buffer-size executor dirty-puts) 369 | add! (if xform (xform add!) add!)] 370 | (->Stream 371 | permanent? 372 | description 373 | producers 374 | consumers 375 | buffer-size 376 | messages 377 | executor 378 | add! 379 | dirty-takes))) 380 | -------------------------------------------------------------------------------- /src/manifold/stream/graph.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.stream.graph 2 | {:no-doc true} 3 | (:require 4 | [manifold.deferred :as d] 5 | [manifold.utils :as utils] 6 | [potemkin.types :refer [deftype+]] 7 | [clj-commons.primitive-math :as p] 8 | [manifold.stream.core :as s] 9 | [manifold.executor :as ex] 10 | [clojure.tools.logging :as log]) 11 | (:import 12 | [java.util 13 | LinkedList] 14 | [java.lang.ref 15 | WeakReference 16 | ReferenceQueue] 17 | [java.util.concurrent 18 | ConcurrentHashMap 19 | CopyOnWriteArrayList] 20 | [manifold.stream.core 21 | IEventStream 22 | IEventSink 23 | IEventSource])) 24 | 25 | (def ^ReferenceQueue ^:private ref-queue (ReferenceQueue.)) 26 | 27 | ;; a map of source handles onto a CopyOnWriteArrayList of sinks 28 | (def ^ConcurrentHashMap handle->downstreams (ConcurrentHashMap.)) 29 | 30 | ;; a map of stream handles onto other handles which have coupled life-cycles 31 | (def ^ConcurrentHashMap handle->connected-handles (ConcurrentHashMap.)) 32 | 33 | (defn conj-to-list! [^ConcurrentHashMap m k x] 34 | (if-let [^CopyOnWriteArrayList l (.get m k)] 35 | (doto l (.add x)) 36 | (let [l (CopyOnWriteArrayList.) 37 | l (or (.putIfAbsent m k l) l)] 38 | (doto ^CopyOnWriteArrayList l 39 | (.add x))))) 40 | 41 | (deftype+ Downstream 42 | [^long timeout 43 | ^boolean upstream? 44 | ^boolean downstream? 45 | ^IEventSink sink 46 | ^String description]) 47 | 48 | (deftype+ AsyncPut 49 | [deferred 50 | ^CopyOnWriteArrayList dsts 51 | dst 52 | ^boolean upstream?]) 53 | 54 | ;;; 55 | 56 | (defn downstream [stream] 57 | (when-let [handle (s/weak-handle stream)] 58 | (when-let [^CopyOnWriteArrayList l (.get handle->downstreams handle)] 59 | (->> l 60 | .iterator 61 | iterator-seq 62 | (map 63 | (fn [^Downstream dwn] 64 | [(.description dwn) (.sink dwn)])))))) 65 | 66 | (defn pop-connected! [stream] 67 | (when-let [handle (s/weak-handle stream)] 68 | (when-let [^CopyOnWriteArrayList l (.remove handle->connected-handles handle)] 69 | (->> l 70 | .iterator 71 | iterator-seq 72 | (map (fn [^WeakReference r] (.get r))) 73 | (remove nil?))))) 74 | 75 | (defn add-connection! [a b] 76 | (conj-to-list! handle->connected-handles (s/weak-handle a) (s/weak-handle b))) 77 | 78 | ;;; 79 | 80 | (defn- async-send 81 | "Returns an AsyncPut with the result of calling a non-blocking .put() on a sink. 82 | If it times out, returns the sink itself as the timeout value." 83 | [^Downstream dwn msg dsts] 84 | (let [^IEventSink sink (.sink dwn)] 85 | (let [x (if (p/== (.timeout dwn) -1) 86 | (.put sink msg false) 87 | (.put sink msg false (.timeout dwn) (if (.downstream? dwn) sink false)))] 88 | (AsyncPut. x dsts dwn (.upstream? dwn))))) 89 | 90 | (defn- sync-send 91 | [^Downstream dwn msg ^CopyOnWriteArrayList dsts ^IEventSink upstream] 92 | (let [^IEventSink sink (.sink dwn) 93 | x (try 94 | (if (p/== (.timeout dwn) -1) 95 | (.put sink msg true) 96 | (.put sink msg true (.timeout dwn) ::timeout)) 97 | (catch Throwable e 98 | (log/error e "error in message propagation") 99 | (s/close! sink) 100 | false))] 101 | (when (p/false? x) 102 | (.remove dsts dwn) 103 | (when upstream 104 | (s/close! upstream))) 105 | (when (and (identical? ::timeout x) (.downstream? dwn)) 106 | (s/close! sink)))) 107 | 108 | (defn- handle-async-put 109 | "Handle a successful async put" 110 | [^AsyncPut x val source] 111 | (let [d (.deferred x) 112 | val (if (instance? IEventSink val) ; it timed out, in which case the val is set to the sink 113 | (do 114 | (s/close! val) 115 | false) 116 | val)] 117 | ;; if sink failed or timed out, remove and maybe close source 118 | (when (false? val) 119 | (let [^CopyOnWriteArrayList l (.dsts x)] 120 | (.remove l (.dst x)) 121 | (when (or (.upstream? x) (p/== 0 (.size l))) 122 | (s/close! source) 123 | (.remove handle->downstreams (s/weak-handle source))))))) 124 | 125 | (defn- handle-async-error [^AsyncPut x err source] 126 | (some-> ^Downstream (.dst x) .sink s/close!) 127 | (log/error err "error in message propagation") 128 | (let [^CopyOnWriteArrayList l (.dsts x)] 129 | (.remove l (.dst x)) 130 | (when (or (.upstream? x) (p/== 0 (.size l))) 131 | (s/close! source) 132 | (.remove handle->downstreams (s/weak-handle source))))) 133 | 134 | (defn- async-connect 135 | "Connects downstreams to an async source. 136 | 137 | Puts to sync sinks are delayed until all async sinks have been successfully put to" 138 | [^IEventSource source 139 | ^CopyOnWriteArrayList dsts] 140 | (let [sync-sinks (LinkedList.) 141 | put-deferreds (LinkedList.) 142 | 143 | ;; asynchronously .put to all synchronous sinks, using callbacks and trampolines as needed 144 | sync-propagate (fn this [recur-point msg] 145 | (loop [] 146 | (let [^Downstream dwn (.poll sync-sinks)] 147 | (if (nil? dwn) 148 | recur-point 149 | (let [^AsyncPut x (async-send dwn msg dsts) 150 | d (.deferred x) 151 | val (d/success-value d ::none)] 152 | (if (identical? val ::none) 153 | (d/on-realized d 154 | (fn [val] 155 | (handle-async-put x val source) 156 | (trampoline #(this recur-point msg))) 157 | (fn [e] 158 | (handle-async-error x e source) 159 | (trampoline #(this recur-point msg)))) 160 | (do 161 | (handle-async-put x val source) 162 | (recur)))))))) 163 | 164 | ;; handle all the async puts, using callbacks and trampolines as needed 165 | ;; then handle all sync puts once asyncs are done 166 | async-propagate (fn this [recur-point msg] 167 | (loop [] 168 | (let [^AsyncPut x (.poll put-deferreds)] 169 | (if (nil? x) 170 | 171 | ;; iterator over sync-sinks when deferreds list is empty 172 | (if (.isEmpty sync-sinks) 173 | recur-point 174 | #(sync-propagate recur-point msg)) 175 | 176 | ;; iterate over async-sinks 177 | (let [d (.deferred x) 178 | val (d/success-value d ::none)] 179 | (if (identical? val ::none) 180 | (d/on-realized d 181 | (fn [val] 182 | (handle-async-put x val source) 183 | (trampoline #(this recur-point msg))) 184 | (fn [e] 185 | (handle-async-error x e source) 186 | (trampoline #(this recur-point msg)))) 187 | (do 188 | (handle-async-put x val source) 189 | (recur)))))))) 190 | 191 | err-callback (fn [err] 192 | (log/error err "error in source of 'connect'") 193 | (.remove handle->downstreams (s/weak-handle source)))] 194 | 195 | (trampoline 196 | (fn this 197 | ([] 198 | (let [d (.take source ::drained false)] 199 | (if (d/realized? d) 200 | (this @d) 201 | (d/on-realized d 202 | (fn [msg] (trampoline #(this msg))) 203 | err-callback)))) 204 | ([msg] 205 | (cond 206 | 207 | (identical? ::drained msg) 208 | (do 209 | (.remove handle->downstreams (s/weak-handle source)) 210 | (let [i (.iterator dsts)] 211 | (loop [] 212 | (when (.hasNext i) 213 | (let [^Downstream dwn (.next i)] 214 | (when (.downstream? dwn) 215 | (s/close! (.sink dwn))) 216 | (recur)))))) 217 | 218 | (p/== 1 (.size dsts)) 219 | (try 220 | (let [dst (.get dsts 0) 221 | ^AsyncPut x (async-send dst msg dsts) 222 | d (.deferred x) 223 | val (d/success-value d ::none)] 224 | 225 | (if (identical? ::none val) 226 | (d/on-realized d 227 | (fn [val] 228 | (handle-async-put x val source) 229 | (trampoline this)) 230 | (fn [e] 231 | (handle-async-error x e source) 232 | (trampoline this))) 233 | (do 234 | (handle-async-put x val source) 235 | this))) 236 | (catch IndexOutOfBoundsException e 237 | (this msg))) 238 | 239 | :else 240 | (let [i (.iterator dsts)] 241 | (if (not (.hasNext i)) 242 | ;; close source if no downstreams 243 | (do 244 | (s/close! source) 245 | (.remove handle->downstreams (s/weak-handle source))) 246 | 247 | ;; otherwise: 248 | ;; 1. add all sync downstreams into a list 249 | ;; 2. attempt to .put() all async downstreams and collect AsyncPuts in a list 250 | ;; 3. call async-propagate 251 | (do 252 | (loop [] 253 | (when (.hasNext i) 254 | (let [^Downstream dwn (.next i)] 255 | (if (s/synchronous? (.sink dwn)) 256 | (.add sync-sinks dwn) 257 | (.add put-deferreds (async-send dwn msg dsts))) 258 | (recur)))) 259 | 260 | (async-propagate this msg)))))))))) 261 | 262 | (defn- sync-connect 263 | "Connects downstreams to a sync source" 264 | [^IEventSource source 265 | ^CopyOnWriteArrayList dsts] 266 | (utils/future-with (ex/wait-pool) 267 | (let [sync-sinks (LinkedList.) 268 | deferreds (LinkedList.)] 269 | (loop [] 270 | (let [i (.iterator dsts)] 271 | (if (.hasNext i) 272 | 273 | (let [msg (.take source ::drained true)] 274 | (if (identical? ::drained msg) 275 | 276 | (do 277 | (.remove handle->downstreams (s/weak-handle source)) 278 | (loop [] 279 | (when (.hasNext i) 280 | (let [^Downstream dwn (.next i)] 281 | (when (.downstream? dwn) 282 | (s/close! (.sink dwn))))))) 283 | 284 | (do 285 | (loop [] 286 | (when (.hasNext i) 287 | (let [^Downstream dwn (.next i)] 288 | (if (s/synchronous? (.sink dwn)) 289 | (.add sync-sinks dwn) 290 | (.add deferreds (async-send dwn msg dsts))) 291 | (recur)))) 292 | 293 | (loop [] 294 | (let [^AsyncPut x (.poll deferreds)] 295 | (if (nil? x) 296 | nil 297 | (do 298 | (try 299 | (handle-async-put x @(.deferred x) source) 300 | (catch Throwable e 301 | (handle-async-error x e source))) 302 | (recur))))) 303 | 304 | (loop [] 305 | (let [^Downstream dwn (.poll sync-sinks)] 306 | (if (nil? dwn) 307 | nil 308 | (do 309 | (sync-send dwn msg dsts (when (.upstream? dwn) source)) 310 | (recur))))) 311 | 312 | (recur)))) 313 | 314 | (do 315 | (s/close! source) 316 | (.remove handle->downstreams (s/weak-handle source))))))))) 317 | 318 | (defn connect 319 | ([^IEventSource src 320 | ^IEventSink dst 321 | {:keys [upstream? 322 | downstream? 323 | timeout 324 | description] 325 | :or {timeout -1 326 | upstream? false 327 | downstream? true} 328 | :as opts}] 329 | (locking src 330 | (let [dwn (Downstream. 331 | timeout 332 | (boolean (and upstream? (instance? IEventSink src))) 333 | downstream? 334 | dst 335 | description) 336 | k (.weakHandle ^IEventStream src ref-queue)] 337 | (if-let [dsts (.get handle->downstreams k)] 338 | (.add ^CopyOnWriteArrayList dsts dwn) 339 | (let [dsts (CopyOnWriteArrayList.)] 340 | (if-let [dsts' (.putIfAbsent handle->downstreams k dsts)] 341 | (.add ^CopyOnWriteArrayList dsts' dwn) 342 | (do 343 | (.add ^CopyOnWriteArrayList dsts dwn) 344 | (if (s/synchronous? src) 345 | (sync-connect src dsts) 346 | (async-connect src dsts)))))))))) 347 | -------------------------------------------------------------------------------- /test/manifold/deferred_test.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.deferred-test 2 | (:refer-clojure :exclude (realized? future loop)) 3 | (:require 4 | [clojure.test :refer :all] 5 | [manifold.test :refer :all] 6 | [manifold.test-utils :refer :all] 7 | [manifold.debug :as debug] 8 | [manifold.deferred :as d] 9 | [manifold.executor :as ex]) 10 | (:import 11 | (java.util.concurrent 12 | CompletableFuture 13 | CompletionStage 14 | TimeoutException) 15 | (manifold.deferred IDeferred))) 16 | 17 | (defmacro future' [& body] 18 | `(d/future 19 | (Thread/sleep 10) 20 | (try 21 | ~@body 22 | (catch Exception e# 23 | (.printStackTrace e#))))) 24 | 25 | (defn future-error 26 | [ex] 27 | (d/future 28 | (Thread/sleep 10) 29 | (throw ex))) 30 | 31 | (defn capture-success 32 | ([result] 33 | (capture-success result true)) 34 | ([result expected-return-value] 35 | (let [p (promise)] 36 | (d/on-realized result 37 | #(do (deliver p %) expected-return-value) 38 | (fn [_] (throw (Exception. "ERROR")))) 39 | p))) 40 | 41 | (defn capture-error 42 | ([result] 43 | (capture-error result true)) 44 | ([result expected-return-value] 45 | (let [p (promise)] 46 | (d/on-realized result 47 | (fn [_] (throw (Exception. "SUCCESS"))) 48 | #(do (deliver p %) expected-return-value)) 49 | p))) 50 | 51 | (deftest test-catch 52 | (is (thrown? ArithmeticException 53 | @(-> 0 54 | (d/chain #(/ 1 %)) 55 | (d/catch IllegalStateException (constantly :foo))))) 56 | 57 | (is (thrown? ArithmeticException 58 | @(-> 0 59 | d/future 60 | (d/chain #(/ 1 %)) 61 | (d/catch IllegalStateException (constantly :foo))))) 62 | 63 | (is (= :foo 64 | @(-> 0 65 | (d/chain #(/ 1 %)) 66 | (d/catch ArithmeticException (constantly :foo))))) 67 | 68 | (let [d (d/deferred)] 69 | (d/future (Thread/sleep 100) (d/error! d :bar)) 70 | (is (= :foo @(d/catch d (constantly :foo))))) 71 | 72 | (is (= :foo 73 | @(-> (d/error-deferred :bar) 74 | (d/catch (constantly :foo))))) 75 | 76 | (is (= :foo 77 | @(-> 0 78 | d/future 79 | (d/chain #(/ 1 %)) 80 | (d/catch ArithmeticException (constantly :foo)))))) 81 | 82 | (def ^:dynamic *test-dynamic-var*) 83 | 84 | (deftest test-let-flow 85 | 86 | (let [flag (atom false)] 87 | @(let [z (clojure.core/future 1)] 88 | (d/let-flow [x (d/future (clojure.core/future z)) 89 | _ (d/future (Thread/sleep 1000) (reset! flag true)) 90 | y (d/future (+ z x))] 91 | (d/future (+ x x y z)))) 92 | (is (= true @flag))) 93 | 94 | (is (= 5 95 | @(let [z (clojure.core/future 1)] 96 | (d/let-flow [x (d/future (clojure.core/future z)) 97 | y (d/future (+ z x))] 98 | (d/future (+ x x y z)))))) 99 | 100 | (is (= 2 101 | @(let [d (d/deferred)] 102 | (d/let-flow [[x] (future' [1])] 103 | (d/let-flow [[x'] (future' [(inc x)]) 104 | y (future' true)] 105 | (when y x')))))) 106 | 107 | (testing "let-flow callbacks happen on different executor retain thread bindings" 108 | (let [d (d/deferred (ex/fixed-thread-executor 1)) 109 | test-internal-fn (fn [] (let [x *test-dynamic-var*] 110 | (d/future (Thread/sleep 100) (d/success! d x))))] 111 | (binding [*test-dynamic-var* "cat"] 112 | (test-internal-fn) 113 | (is (= ["cat" "cat" "cat"] 114 | @(d/let-flow [a d 115 | b (do a *test-dynamic-var*)] 116 | [a b *test-dynamic-var*]))))))) 117 | 118 | (deftest test-chain-errors 119 | (let [boom (fn [n] (throw (ex-info "" {:n n})))] 120 | (doseq [b [boom (fn [n] (d/future (boom n)))]] 121 | (dorun 122 | (for [i (range 10) 123 | j (range 10)] 124 | (let [fs (concat (repeat i inc) [boom] (repeat j inc))] 125 | (is (= i 126 | @(-> (apply d/chain 0 fs) 127 | (d/catch (fn [e] (:n (ex-data e))))) 128 | @(-> (apply d/chain' 0 fs) 129 | (d/catch' (fn [e] (:n (ex-data e))))))))))))) 130 | 131 | (deftest test-chain 132 | (dorun 133 | (for [i (range 10) 134 | j (range i)] 135 | (let [fs (take i (cycle [inc #(* % 2)])) 136 | fs' (-> fs 137 | vec 138 | (update-in [j] (fn [f] #(d/future (f %)))))] 139 | (is 140 | (= (reduce #(%2 %1) 0 fs) 141 | @(apply d/chain 0 fs') 142 | @(apply d/chain' 0 fs'))))))) 143 | 144 | (deftest test-deferred 145 | ;; success! 146 | (let [d (d/deferred)] 147 | (is (= true (d/success! d 1))) 148 | (is (= 1 @(capture-success d))) 149 | (is (= 1 @d))) 150 | 151 | ;; claim and success! 152 | (let [d (d/deferred) 153 | token (d/claim! d)] 154 | (is token) 155 | (is (= false (d/success! d 1))) 156 | (is (= true (d/success! d 1 token))) 157 | (is (= 1 @(capture-success d))) 158 | (is (= 1 @d))) 159 | 160 | ;; error! 161 | (let [d (d/deferred) 162 | ex (IllegalStateException. "boom")] 163 | (is (= true (d/error! d ex))) 164 | (is (= ex @(capture-error d ::return))) 165 | (is (thrown? IllegalStateException @d))) 166 | 167 | ;; claim and error! 168 | (let [d (d/deferred) 169 | ex (IllegalStateException. "boom") 170 | token (d/claim! d)] 171 | (is token) 172 | (is (= false (d/error! d ex))) 173 | (is (= true (d/error! d ex token))) 174 | (is (= ex @(capture-error d ::return))) 175 | (is (thrown? IllegalStateException (deref d 1000 ::timeout)))) 176 | 177 | ;; test deref with delayed result 178 | (let [d (d/deferred)] 179 | (future' (d/success! d 1)) 180 | (is (= 1 (deref d 1000 ::timeout)))) 181 | 182 | ;; test deref with delayed error result 183 | (let [d (d/deferred)] 184 | (future' (d/error! d (IllegalStateException. "boom"))) 185 | (is (thrown? IllegalStateException (deref d 1000 ::timeout)))) 186 | 187 | ;; test deref with non-Throwable error result 188 | (are [d timeout] 189 | (= :bar 190 | (-> (is (thrown? clojure.lang.ExceptionInfo 191 | (if timeout (deref d 1000 ::timeout) @d))) 192 | ex-data 193 | :error)) 194 | 195 | (doto (d/deferred) (d/error! :bar)) true 196 | 197 | (doto (d/deferred) (as-> d (future' (d/error! d :bar)))) true 198 | 199 | (d/error-deferred :bar) true 200 | 201 | (d/error-deferred :bar) false) 202 | 203 | ;; multiple callbacks w/ success 204 | (let [n 50 205 | d (d/deferred) 206 | callback-values (->> (range n) 207 | (map (fn [_] (d/future (capture-success d)))) 208 | (map deref) 209 | doall)] 210 | (is (= true (d/success! d 1))) 211 | (is (= 1 (deref d 1000 ::timeout))) 212 | (is (= (repeat n 1) (map deref callback-values)))) 213 | 214 | ;; multiple callbacks w/ error 215 | (let [n 50 216 | d (d/deferred) 217 | callback-values (->> (range n) 218 | (map (fn [_] (d/future (capture-error d)))) 219 | (map deref) 220 | doall) 221 | ex (Exception.)] 222 | (is (= true (d/error! d ex))) 223 | (is (thrown? Exception (deref d 1000 ::timeout))) 224 | (is (= (repeat n ex) (map deref callback-values)))) 225 | 226 | ;; cancel listeners 227 | (let [l (d/listener (constantly :foo) nil) 228 | d (d/deferred)] 229 | (is (= false (d/cancel-listener! d l))) 230 | (is (= true (d/add-listener! d l))) 231 | (is (= true (d/cancel-listener! d l))) 232 | (is (= true (d/success! d :foo))) 233 | (is (= :foo @(capture-success d))) 234 | (is (= false (d/cancel-listener! d l)))) 235 | 236 | ;; deref 237 | (let [d (d/deferred)] 238 | (is (= :foo (deref d 10 :foo))) 239 | (d/success! d 1) 240 | (is (= 1 @d)) 241 | (is (= 1 (deref d 10 :foo))))) 242 | 243 | (deftest test-timeout 244 | (testing "exception by default" 245 | (let [d (d/deferred) 246 | t (d/timeout! d 1)] 247 | (is (identical? d t)) 248 | (is (thrown-with-msg? TimeoutException 249 | #"^timed out after 1 milliseconds$" 250 | (deref d 100 ::error))))) 251 | 252 | (testing "custom default value" 253 | (let [d (d/deferred) 254 | t (d/timeout! d 1 ::timeout)] 255 | (is (identical? d t)) 256 | (is (deref (capture-success d ::timeout) 100 ::error)))) 257 | 258 | (testing "error before timeout" 259 | (let [ex (Exception.) 260 | d (d/deferred) 261 | t (d/timeout! d 1000)] 262 | (d/error! d ex) 263 | (is (= ex (deref (capture-error t) 10 ::error)))))) 264 | 265 | (deftest test-loop 266 | ;; body produces a non-deferred value 267 | (is @(capture-success 268 | (d/loop [] true))) 269 | 270 | ;; body raises exception 271 | (let [ex (Exception.)] 272 | (is (= ex @(capture-error 273 | (d/loop [] (throw ex)))))) 274 | 275 | ;; body produces a realized result 276 | (is @(capture-success 277 | (d/loop [] (d/success-deferred true)))) 278 | 279 | ;; body produces a realized error result 280 | (let [ex (Exception.)] 281 | (is (= ex @(capture-error 282 | (d/loop [] (d/error-deferred ex)))))) 283 | 284 | ;; body produces a delayed result 285 | (is @(capture-success 286 | (d/loop [] (future' true)))) 287 | 288 | ;; body produces a delayed error result 289 | (let [ex (Exception.)] 290 | (is (= ex @(capture-error 291 | (d/loop [] (future-error ex)))))) 292 | 293 | ;; destructuring works for loop parameters 294 | (is (= 1 @(capture-success 295 | (d/loop [{:keys [a]} {:a 1}] a)))) 296 | (is @(capture-success 297 | (d/loop [[x & xs] [1 2 3]] (or (= x 3) (d/recur xs)))))) 298 | 299 | (deftest test-coercion 300 | (is (= 1 (-> 1 clojure.core/future d/->deferred deref))) 301 | 302 | (let [f (CompletableFuture.)] 303 | (.obtrudeValue f 1) 304 | (is (= 1 (-> f d/->deferred deref)))) 305 | 306 | (let [f (CompletableFuture.)] 307 | (.obtrudeException f (Exception.)) 308 | (is (thrown? Exception (-> f d/->deferred deref))))) 309 | 310 | (deftest test-finally 311 | (let [target-d (d/deferred) 312 | d (d/deferred) 313 | fd (-> d 314 | (d/finally 315 | (fn [] 316 | (d/success! target-d ::delivered))) 317 | ;; to silence dropped error detection 318 | (d/catch identity))] 319 | (d/error! d (Exception.)) 320 | (is (= ::delivered (deref target-d 0 ::not-delivered))))) 321 | 322 | (deftest test-alt 323 | (is (#{1 2 3} @(d/alt 1 2 3))) 324 | (let [d (d/deferred) 325 | a (d/alt d 2)] 326 | (d/success! d 1) 327 | (is (= 2 @a))) 328 | 329 | (let [d (d/deferred) 330 | a (d/alt d 2)] 331 | (doto d 332 | (d/error! (Exception. "boom 1")) 333 | ;; to silence dropped error detection 334 | (d/catch identity)) 335 | (is (= 2 @a))) 336 | 337 | (let [e (d/error-deferred (Exception. "boom 2")) 338 | d (d/deferred) 339 | a (d/alt e d)] 340 | (d/success! d 1) 341 | (is (thrown-with-msg? Exception #"boom" @a))) 342 | 343 | (testing "uniformly distributed" 344 | (let [results (atom {}) 345 | ;; within 10% 346 | n 1e4, r 10, eps (* n 0.15) 347 | f #(/ (% n eps) r)] 348 | (dotimes [_ n] 349 | @(d/chain (apply d/alt (range r)) 350 | #(swap! results update % (fnil inc 0)))) 351 | (doseq [[i times] @results] 352 | (is (<= (f -) times (f +))))))) 353 | 354 | ;;; 355 | 356 | (deftest ^:ignore-dropped-errors ^:benchmark benchmark-chain 357 | (bench "invoke comp x1" 358 | ((comp inc) 0)) 359 | (bench "chain x1" 360 | @(d/chain 0 inc)) 361 | (bench "chain' x1" 362 | @(d/chain' 0 inc)) 363 | (bench "invoke comp x2" 364 | ((comp inc inc) 0)) 365 | (bench "chain x2" 366 | @(d/chain 0 inc inc)) 367 | (bench "chain' x2" 368 | @(d/chain' 0 inc inc)) 369 | (bench "invoke comp x5" 370 | ((comp inc inc inc inc inc) 0)) 371 | (bench "chain x5" 372 | @(d/chain 0 inc inc inc inc inc)) 373 | (bench "chain' x5" 374 | @(d/chain' 0 inc inc inc inc inc))) 375 | 376 | (deftest ^:ignore-dropped-errors ^:benchmark benchmark-deferred 377 | (bench "create deferred" 378 | (d/deferred)) 379 | (bench "add-listener and success" 380 | (let [d (d/deferred)] 381 | (d/add-listener! d (d/listener (fn [_]) nil)) 382 | (d/success! d 1))) 383 | (bench "add-listener, claim, and success!" 384 | (let [d (d/deferred)] 385 | (d/add-listener! d (d/listener (fn [_]) nil)) 386 | (d/success! d 1 (d/claim! d)))) 387 | (bench "add-listener!, cancel, add-listener! and success" 388 | (let [d (d/deferred)] 389 | (let [callback (d/listener (fn [_]) nil)] 390 | (d/add-listener! d callback) 391 | (d/cancel-listener! d callback)) 392 | (d/add-listener! d (d/listener (fn [_]) nil)) 393 | (d/success! d 1))) 394 | (bench "multi-add-listener! and success" 395 | (let [d (d/deferred)] 396 | (d/add-listener! d (d/listener (fn [_]) nil)) 397 | (d/add-listener! d (d/listener (fn [_]) nil)) 398 | (d/success! d 1))) 399 | (bench "multi-add-listener!, cancel, and success" 400 | (let [d (d/deferred)] 401 | (d/add-listener! d (d/listener (fn [_]) nil)) 402 | (let [callback (d/listener (fn [_]) nil)] 403 | (d/add-listener! d callback) 404 | (d/cancel-listener! d callback)) 405 | (d/success! d 1))) 406 | (bench "success! and add-listener!" 407 | (let [d (d/deferred)] 408 | (d/success! d 1) 409 | (d/add-listener! d (d/listener (fn [_]) nil)))) 410 | (bench "claim, success!, and add-listener!" 411 | (let [d (d/deferred)] 412 | (d/success! d 1 (d/claim! d)) 413 | (d/add-listener! d (d/listener (fn [_]) nil)))) 414 | (bench "success! and deref" 415 | (let [d (d/deferred)] 416 | (d/success! d 1) 417 | @d)) 418 | (bench "deliver and deref" 419 | (let [d (d/deferred)] 420 | (deliver d 1) 421 | @d))) 422 | 423 | (deftest ^:ignore-dropped-errors ^:stress test-error-leak-detection 424 | (testing "error-deferred always detects dropped errors" 425 | (expect-dropped-errors 1 426 | (d/error-deferred (Throwable.)))) 427 | 428 | (testing "regular deferreds detect errors on every debug/*leak-aware-deferred-rate*'th instance (1024 by default)" 429 | (expect-dropped-errors 2 430 | ;; Explicitly restating the (current) default here for clarity 431 | (binding [debug/*leak-aware-deferred-rate* 1024] 432 | (dotimes [_ 2048] 433 | (d/error! (d/deferred) (Throwable.))))))) 434 | 435 | (deftest ^:ignore-dropped-errors ^:stress test-deferred-chain 436 | (dotimes [_ 1e4] 437 | (let [d (d/deferred) 438 | result (d/future 439 | (last 440 | (take 1e4 441 | (iterate 442 | #(let [d' (d/deferred)] 443 | (d/connect % d') 444 | d') 445 | d))))] 446 | (Thread/sleep ^long (rand-int 10)) 447 | (d/success! d 1) 448 | (is (= 1 @@result))))) 449 | 450 | ;; Promesa adds CompletionStage to the print-method hierarchy, which can cause 451 | ;; problems if neither is preferred over the other 452 | (deftest promesa-print-method-test 453 | (testing "print-method hierarchy compatibility with promesa") 454 | (try 455 | (let [print-method-dispatch-vals (-> print-method methods keys set)] 456 | (is (= IDeferred 457 | (get print-method-dispatch-vals IDeferred ::missing))) 458 | (is (= ::missing 459 | (get print-method-dispatch-vals CompletionStage ::missing))) 460 | 461 | (let [d (d/deferred)] 462 | (is (instance? IDeferred d)) 463 | (is (instance? CompletionStage d)) 464 | 465 | (testing "no conflicts - CompletionStage not dispatchable" 466 | (pr-str d)) 467 | 468 | (testing "no conflicts - preferred hierarchy established" 469 | (defmethod print-method CompletionStage [o ^java.io.Writer w] 470 | :noop) 471 | 472 | (pr-str d)))) 473 | 474 | (finally 475 | (remove-method print-method CompletionStage)))) 476 | 477 | (instrument-tests-with-dropped-error-detection!) 478 | -------------------------------------------------------------------------------- /test/manifold/stream_test.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.stream-test 2 | (:require 3 | [clojure.tools.logging :as log] 4 | [clojure.core.async :as async] 5 | [clojure.test :refer :all] 6 | [manifold.test-utils :refer :all] 7 | [manifold.test :refer :all] 8 | [manifold.stream :as s] 9 | [manifold.stream.default :as sd] 10 | [manifold.utils :as utils] 11 | [manifold.deferred :as d] 12 | [manifold.executor :as ex]) 13 | (:import 14 | [java.util.concurrent 15 | Executors 16 | BlockingQueue 17 | ArrayBlockingQueue 18 | SynchronousQueue 19 | TimeUnit])) 20 | 21 | (defn run-sink-source-test [gen] 22 | (let [x (gen) 23 | sink (s/->sink x) 24 | source (s/->source x) 25 | vs (range 1e4)] 26 | 27 | (reset-meta! sink nil) 28 | (is (= nil (meta sink))) 29 | (reset-meta! sink {1 2}) 30 | (alter-meta! sink assoc 3 4) 31 | (is (= {1 2 3 4} (meta sink))) 32 | 33 | (reset-meta! source nil) 34 | (is (= nil (meta source))) 35 | (reset-meta! source {1 2}) 36 | (alter-meta! source assoc 3 4) 37 | (is (= {1 2 3 4} (meta source))) 38 | 39 | (is (thrown? ClassCastException (with-meta source {}))) 40 | (is (thrown? ClassCastException (with-meta sink {}))) 41 | 42 | (future 43 | (doseq [x vs] 44 | (try 45 | @(s/put! sink x) 46 | (catch Throwable e 47 | (log/error e ""))))) 48 | (is (= vs (repeatedly (count vs) #(deref (s/take! source))))) 49 | 50 | #_(future 51 | (doseq [x vs] 52 | (try 53 | (s/put! sink x) 54 | (catch Throwable e 55 | (log/error e ""))))) 56 | #_(is (= vs (repeatedly (count vs) #(deref (s/take! source))))) 57 | 58 | (future 59 | (doseq [x vs] 60 | (try 61 | @(s/try-put! sink x 100 ::timeout) 62 | (catch Throwable e 63 | (log/error e ""))))) 64 | (is (= vs (repeatedly (count vs) #(deref (s/take! source))))) 65 | 66 | (future 67 | (doseq [x vs] 68 | (try 69 | @(s/put! sink x) 70 | (catch Throwable e 71 | (log/error e ""))))) 72 | (is (= vs (s/stream->seq source 100))))) 73 | 74 | (defn splice-into-stream [gen] 75 | #(let [x (gen) 76 | s (s/stream)] 77 | (s/connect x s nil) 78 | (s/splice x s))) 79 | 80 | (def executor (ex/fixed-thread-executor 8)) 81 | 82 | (deftest test-streams 83 | 84 | (run-sink-source-test s/stream) 85 | (run-sink-source-test #(s/stream 1 nil executor)) 86 | (run-sink-source-test #(async/chan 100)) 87 | (run-sink-source-test #(ArrayBlockingQueue. 100)) 88 | (run-sink-source-test #(SynchronousQueue.)) 89 | 90 | (run-sink-source-test (splice-into-stream s/stream)) 91 | (run-sink-source-test (splice-into-stream #(s/stream 1 nil executor))) 92 | (run-sink-source-test (splice-into-stream #(ArrayBlockingQueue. 100))) 93 | (run-sink-source-test (splice-into-stream #(async/chan 100)))) 94 | 95 | (deftest test-sources 96 | (doseq [f [#(java.util.ArrayList. ^java.util.List %) 97 | #(.iterator ^java.util.List %) 98 | #(-> % (java.util.ArrayList.) .stream)]] 99 | (when f 100 | (= (range 100) (-> (range 100) f s/->source s/stream->seq))) 101 | (when f 102 | (= (range 100) (-> (range 100) f s/->source (s/stream->seq 10)))))) 103 | 104 | ;;; 105 | 106 | (deftest test-pending-takes-and-puts-cleaned-up 107 | (let [timeout 1 108 | default-val ::default 109 | timeout-val ::timeout] 110 | (testing "take one more than the max number of allowed pending takes" 111 | (let [pending-s (sd/stream)] 112 | (dotimes [_ sd/max-consumers] 113 | (s/try-take! pending-s default-val timeout timeout-val)) 114 | (is (= timeout-val @(s/try-take! pending-s default-val timeout timeout-val)) 115 | "Should timeout and deliver timeout-val instead of failing and returning default-val"))) 116 | (testing "put one more than the max number of allowed pending puts" 117 | (let [pending-s (sd/stream)] 118 | (dotimes [_ sd/max-producers] 119 | (s/try-put! pending-s ::x timeout timeout-val)) 120 | (is (= timeout-val @(s/try-put! pending-s ::x timeout timeout-val)) 121 | "Should timeout and deliver timeout-val"))))) 122 | 123 | (deftest test-deliver-pending-takes-on-close 124 | (let [input-s (s/stream) 125 | result-s (s/stream) 126 | end-s (s/stream)] 127 | (dotimes [n 5] 128 | (doto (Thread. 129 | (fn [] 130 | (loop [] 131 | (when-let [x @(s/take! input-s)] 132 | (s/put! result-s "result") 133 | (recur))) 134 | (s/put! end-s "end"))) 135 | (.start))) 136 | 137 | (is (= false (s/closed? input-s))) 138 | (is (= false (s/closed? result-s))) 139 | (is (= false (s/closed? end-s))) 140 | 141 | (dotimes [n 10] (s/put! input-s "input")) 142 | 143 | (is (= (repeat 10 "result") (take 10 (s/stream->seq result-s 1000)))) 144 | 145 | (s/close! input-s) 146 | 147 | (is (= true (s/closed? input-s))) 148 | 149 | (is (= (repeat 5 "end") (take 5 (s/stream->seq end-s 1000)))) 150 | 151 | (s/close! result-s) 152 | (s/close! end-s) 153 | 154 | (is (= true (s/drained? input-s))) 155 | (is (= true (s/drained? result-s))) 156 | (is (= true (s/drained? end-s))))) 157 | 158 | (deftest test-closed-and-drained 159 | (let [s (s/stream)] 160 | (s/put! s 1) 161 | (is (= false (s/closed? s))) 162 | 163 | (s/close! s) 164 | 165 | (is (= false @(s/put! s 2))) 166 | (is (= true (s/closed? s))) 167 | (is (= false (s/drained? s))) 168 | (is (= 1 @(s/take! s))) 169 | (is (= nil @(s/take! s))) 170 | (is (= true (s/drained? s))))) 171 | 172 | (deftest test-transducers 173 | (let [s (s/stream 0 174 | (comp 175 | (map inc) 176 | (filter even?) 177 | (take 3)))] 178 | (s/put-all! s (range 10)) 179 | (is (= [2 4 6] (s/stream->seq s)))) 180 | 181 | (are [xform input] 182 | (= (s/stream->seq (s/transform xform (s/->source input))) 183 | (transduce xform conj [] input)) 184 | 185 | (mapcat #(repeat 3 %)) (range 10) 186 | 187 | (map inc) (range 10) 188 | 189 | (map inc) (vec (range 10)) 190 | 191 | (comp (map inc) (filter even?)) (range 10) 192 | 193 | (comp (map inc) (take 5)) (range 10) 194 | 195 | (partition-all 5) (range 12) 196 | 197 | (comp (partition-all 5) (map count)) (range 13) 198 | )) 199 | 200 | (deftest test-accumulating-transducer-with-multiple-consumers 201 | 202 | ;; This tests a very particular code path while closing 203 | ;; streams with a transducer and multiple consumers. 204 | 205 | ;; When closing a transformed stream with multiple consumers 206 | ;; and an accumulated transducer state, one consumer must 207 | ;; receive the last message. The last message should not be 208 | ;; discarded, and the consumers should not be abandoned. 209 | 210 | ;; The consumers need to start listening before messages 211 | ;; are available, and there should be more than one 212 | ;; consumer remaining at the time the stream is closed. 213 | 214 | (let [s (s/stream 0 (partition-all 3)) 215 | 216 | d (-> (d/zip (s/take! s :drained) 217 | (s/take! s :drained) 218 | (s/take! s :drained)) 219 | 220 | (d/chain (partial into #{})))] 221 | 222 | (-> (s/put-all! s (range 5)) 223 | (d/finally (partial s/close! s))) 224 | 225 | (is (= #{[0 1 2] [3 4] :drained} 226 | (deref d 100 :incomplete!))))) 227 | 228 | 229 | (deftest test-reduce 230 | (let [inputs (range 1e2)] 231 | (is 232 | (= (reduce + inputs) 233 | @(s/reduce + (s/->source inputs)))) 234 | (is 235 | (= (reduce + 1 inputs) 236 | @(s/reduce + 1 (s/->source inputs))))) 237 | 238 | (let [inputs (range 10) 239 | accf (fn [acc el] 240 | (if (= el 5) (reduced :large) el)) 241 | s (s/->source inputs)] 242 | (is (= :large 243 | (reduce accf 0 inputs) 244 | @(s/reduce accf 0 s))) 245 | (is (not (s/drained? s))) 246 | (is (= 6 @(s/try-take! s 1))))) 247 | 248 | (deftest test-zip 249 | (let [inputs (partition-all 1e4 (range 3e4))] 250 | (is 251 | (= (apply map vector inputs) 252 | (->> inputs 253 | (map s/->source) 254 | (apply s/zip) 255 | s/stream->seq))))) 256 | 257 | (deftest test-lazily-partition-by 258 | (let [inputs (range 1e2) 259 | f #(long (/ % 10))] 260 | (is 261 | (= (partition-by f inputs) 262 | (->> inputs 263 | s/->source 264 | (s/lazily-partition-by f) 265 | s/stream->seq 266 | (map (comp doall s/stream->seq))))))) 267 | 268 | (defn test-batch [metric max-size] 269 | (let [inputs (repeat 10 metric) 270 | outputs (partition-all (quot max-size metric) inputs)] 271 | (is 272 | (= outputs 273 | (->> inputs 274 | s/->source 275 | (s/batch identity max-size 1e4) 276 | s/stream->seq))))) 277 | 278 | (deftest test-batch-default 279 | (test-batch 1 5)) 280 | 281 | (deftest test-batch-with-metric 282 | (test-batch 2 5)) 283 | 284 | (deftest test-batch-with-oversized-message 285 | (let [inputs [1 1 9] 286 | outputs [[1 1] [9]]] 287 | (is 288 | (= outputs 289 | (->> inputs 290 | s/->source 291 | (s/batch identity 2 1e4) 292 | s/stream->seq))))) 293 | 294 | (deftest test-concat 295 | (let [inputs (range 1e2) 296 | f #(long (/ % 10))] 297 | (is 298 | (= inputs 299 | (->> inputs 300 | s/->source 301 | (s/lazily-partition-by f) 302 | s/concat 303 | s/stream->seq))))) 304 | 305 | (deftest test-buffer 306 | (let [s (s/buffered-stream identity 10)] 307 | 308 | (let [a (s/put! s 9) 309 | b (s/put! s 2)] 310 | (is (d/realized? a)) 311 | (is (= true @a)) 312 | (is (not (d/realized? b))) 313 | (is (= 9 @(s/take! s))) 314 | (is (d/realized? b)) 315 | (is (= true @b)) 316 | (let [c (s/put! s 12) 317 | d (s/put! s 1)] 318 | (is (not (or (d/realized? c) (d/realized? d)))) 319 | (is (= 2 @(s/take! s))) 320 | (is (not (or (d/realized? c) (d/realized? d)))) 321 | (is (= 12 @(s/take! s))) 322 | (is (d/realized? d)) 323 | (is (= true @d)) 324 | (is (= 1 @(s/take! s))))))) 325 | 326 | (deftest test-operations 327 | (are [seq-f stream-f f input] 328 | 329 | (apply = 330 | 331 | ;; seq version 332 | (seq-f f input) 333 | 334 | ;; single operation 335 | (->> (s/->source input) 336 | (stream-f f) 337 | s/stream->seq) 338 | 339 | ;; three simultaneous operations 340 | (let [src (s/stream) 341 | f #(->> src 342 | (stream-f f) 343 | (s/buffer (count input))) 344 | dsts (doall (repeatedly 3 f))] 345 | (d/chain (s/put-all! src input) 346 | (fn [_] (s/close! src))) 347 | (map s/stream->seq dsts))) 348 | 349 | map s/map inc (range 10) 350 | 351 | filter s/filter even? (range 10) 352 | 353 | mapcat s/mapcat list (range 10) 354 | 355 | reductions s/reductions + (range 10) 356 | 357 | #(reductions %1 1 %2) #(s/reductions %1 1 %2) + (range 10))) 358 | 359 | (defn dechunk [s] 360 | (lazy-seq 361 | (when-let [[x] (seq s)] 362 | (cons x (dechunk (rest s)))))) 363 | 364 | (deftest test-cleanup 365 | (let [cnt (atom 0) 366 | f (fn [idx] 367 | (swap! cnt inc) 368 | (d/future 369 | (range (* idx 10) (+ 10 (* idx 10)))))] 370 | (is (= (range 10) 371 | (->> (range) 372 | dechunk 373 | (map f) 374 | s/->source 375 | s/realize-each 376 | (s/map s/->source) 377 | s/concat 378 | (s/transform (take 10)) 379 | s/stream->seq))) 380 | #_(is (= 1 @cnt)))) 381 | 382 | (deftest test-drain-into 383 | (let [n 100 384 | src (s/->source (range n)) 385 | dst (s/stream) 386 | result (s/drain-into src dst)] 387 | (is (= (range n) (->> dst s/stream->seq (take n)))) 388 | (is (= true @result)))) 389 | 390 | (deftest test-consume 391 | (let [src (s/->source [1 2 3]) 392 | values (atom []) 393 | result (-> (s/consume #(swap! values conj %) src) 394 | (d/chain #(do (swap! values conj ::done) %)))] 395 | (is (= true @result)) 396 | (is (= [1 2 3 ::done] @values)))) 397 | 398 | (deftest test-consume-async 399 | (let [src (s/->source [1 2]) 400 | values (atom []) 401 | result (s/consume-async #(do (swap! values conj %) 402 | (d/success-deferred (= (count @values) 1))) 403 | src)] 404 | (is (true? (deref result 100 ::not-done))) 405 | (is (= [1 2] @values)))) 406 | 407 | (deftest test-periodically 408 | (testing "produces with delay" 409 | (let [s (s/periodically 20 0 (constantly 1))] 410 | (Thread/sleep 30) 411 | (s/close! s) 412 | ;; will produces 2 items here no matter the sleep amount 413 | ;; as the periodically stream has a buffer of 1 414 | (is (= [1 1] (s/stream->seq s))))) 415 | 416 | (testing "doesn't fail on nil" 417 | (let [s (s/periodically 100 0 (constantly nil))] 418 | (Thread/sleep 150) 419 | (s/close! s) 420 | (is (= [nil nil] (s/stream->seq s)))))) 421 | 422 | (deftest test-try-put 423 | (testing "times out" 424 | (let [s (s/stream) 425 | put-result (s/try-put! s :value 10 ::timeout)] 426 | (is (= ::timeout (deref put-result 15 ::wrong)))))) 427 | 428 | (deftest test-error-handling 429 | 430 | (binding [log/*logger-factory* clojure.tools.logging.impl/disabled-logger-factory] 431 | 432 | (let [s (s/stream) 433 | s' (s/map #(/ 1 %) s)] 434 | (is (not (s/closed? s))) 435 | (is (not (s/drained? s'))) 436 | (is (= false @(s/put-all! s [0 1]))) 437 | (is (s/closed? s)) 438 | (is (s/drained? s'))) 439 | 440 | (let [s (s/stream) 441 | s' (s/map #(d/future (/ 1 %)) s)] 442 | (is (not (s/closed? s))) 443 | (is (not (s/drained? s'))) 444 | (is (= true @(s/put! s 0))) 445 | (is (not (s/closed? s))) 446 | (is (not (s/drained? s')))) 447 | 448 | (let [s (s/stream) 449 | s' (->> s 450 | (s/map #(d/future (/ 1 %))) 451 | s/realize-each)] 452 | (is (not (s/closed? s))) 453 | (is (not (s/drained? s'))) 454 | (s/put-all! s (range 10)) 455 | (is (nil? @(s/take! s'))) 456 | (is (s/drained? s'))))) 457 | 458 | (deftest test-connect-timeout 459 | (let [src (s/stream) 460 | sink (s/stream)] 461 | 462 | (s/connect src sink {:timeout 10}) 463 | (s/put-all! src (range 10)) 464 | (Thread/sleep 100) 465 | 466 | (is (s/closed? sink)) 467 | (is (s/closed? src)))) 468 | 469 | (deftest test-window-streams 470 | (testing "dropping-stream" 471 | (let [s (s/->source (range 11)) 472 | dropping-s (s/dropping-stream 10 s)] 473 | (is (= (range 10) 474 | (s/stream->seq dropping-s))))) 475 | 476 | (testing "sliding-stream" 477 | (let [s (s/->source (range 11)) 478 | sliding-s (s/sliding-stream 10 s)] 479 | (is (= (range 1 11) 480 | (s/stream->seq sliding-s)))))) 481 | 482 | ;;; 483 | 484 | (deftest ^:ignore-dropped-errors ^:stress stress-buffered-stream 485 | (let [s (s/buffered-stream identity 100)] 486 | (future 487 | (dotimes [_ 1e6] 488 | @(s/put! s (rand-int 200))) 489 | (s/close! s)) 490 | (-> s s/stream->seq dorun))) 491 | 492 | ;;; 493 | 494 | (defn blocking-queue-benchmark [^BlockingQueue q] 495 | (future 496 | (dotimes [i 1e3] 497 | (.put q i))) 498 | (dotimes [i 1e3] 499 | (.take q))) 500 | 501 | (defn core-async-benchmark [ch] 502 | (async/go 503 | (dotimes [i 1e3] 504 | (async/>! ch i))) 505 | (dotimes [i 1e3] 506 | (async/!! ch i))) 512 | (dotimes [i 1e3] 513 | (async/! c 1)) 544 | (async/! c 1)) 562 | (async/!! ch 1) 582 | (async/Function fn->Consumer fn->BiFunction fn->BiConsumer]] 6 | [clojure.test :refer [deftest is testing]]) 7 | (:import [java.util.concurrent 8 | CompletionStage 9 | CompletableFuture 10 | Executors])) 11 | 12 | (defn fn1->Runnable [f] 13 | (reify java.lang.Runnable 14 | (run [_] (f nil)))) 15 | 16 | (defn fn2->Runnable [f] 17 | (reify java.lang.Runnable 18 | (run [_] (f nil nil)))) 19 | 20 | ;; On these tests: 21 | ;; CompletionStage has many methods that mimic the chain, zip and alt 22 | ;; functions in manifold. Unfortunately, each of these has 3 different versions, 23 | ;; one for each java functional interaface, and each version has 3 24 | ;; variants/modes, a raw/same thread variant, an async variant which runs in 25 | ;; a separate thread when possible, and an async variant that runs 26 | ;; in a given executor. 27 | 28 | (def functor-method-info 29 | [{:methods {:raw 30 | (fn [^CompletionStage this operator _] 31 | (.thenApply this operator)) 32 | :async 33 | (fn [^CompletionStage this operator _] 34 | (.thenApplyAsync this operator)) 35 | :with-executor 36 | (fn [^CompletionStage this operator executor] 37 | (.thenApplyAsync this operator executor))} 38 | 39 | :interface fn->Function 40 | :inner-assertion #(is (= "a test string" %)) 41 | :post-assertion #(is (= true %))} 42 | 43 | {:methods {:raw (fn [^CompletionStage this operator _] 44 | (.thenAccept this operator)) 45 | :async (fn [^CompletionStage this operator _] 46 | (.thenAcceptAsync this operator)) 47 | :with-executor 48 | (fn [^CompletionStage this operator executor] 49 | (.thenAcceptAsync this operator executor))} 50 | :interface fn->Consumer 51 | :inner-assertion #(is (= % "a test string")) 52 | :post-assertion #(is (= % nil))} 53 | 54 | {:methods {:raw (fn [^CompletionStage this operator _] 55 | (.thenRun this operator)) 56 | :async (fn [^CompletionStage this operator _] 57 | (.thenRunAsync this operator)) 58 | :with-executor 59 | (fn [^CompletionStage this operator executor] 60 | (.thenRunAsync this operator executor))} 61 | :interface fn1->Runnable 62 | :inner-assertion #(is (= % nil)) 63 | :post-assertion #(is (= % nil))}]) 64 | 65 | (defn test-functor-success [method-info mode executor] 66 | 67 | (let [was-called (atom false) 68 | 69 | method (get-in method-info [:methods mode]) 70 | {:keys [inner-assertion post-assertion] 71 | to-java-interface :interface} method-info 72 | 73 | d1 (d/success-deferred "a test string") 74 | d2 (method 75 | d1 76 | (to-java-interface 77 | (fn [x] 78 | (inner-assertion x) 79 | (reset! was-called true) 80 | (= x "a test string"))) 81 | executor)] 82 | 83 | (is (= "a test string" @d1)) 84 | (post-assertion @d2) 85 | (is (= true @was-called)))) 86 | 87 | (defn test-functor-error [method-info mode executor] 88 | 89 | (let [was-called (atom false) 90 | method (get-in method-info [:methods mode]) 91 | {to-java-interface :interface} method-info 92 | 93 | d1 (d/error-deferred (RuntimeException.)) 94 | d2 (method 95 | d1 96 | (to-java-interface 97 | (fn [_] 98 | (reset! was-called true))) 99 | executor)] 100 | 101 | (is (thrown? RuntimeException @d1)) 102 | (is (thrown? RuntimeException @d2)) 103 | (is (= false @was-called)))) 104 | 105 | (deftest test-functor-methods 106 | 107 | (let [executor (Executors/newSingleThreadExecutor)] 108 | (testing "functor success" 109 | (dorun (for [method-info functor-method-info 110 | mode [:raw :async :with-executor]] 111 | (test-functor-success method-info mode executor)))) 112 | 113 | (testing "functor error" 114 | (dorun (for [method-info functor-method-info 115 | mode [:raw :async :with-executor]] 116 | (test-functor-error method-info mode executor)))))) 117 | 118 | (def zip-method-info 119 | [{:methods {:raw 120 | (fn [^CompletionStage this other operator _] 121 | (.thenCombine this other operator)) 122 | :async 123 | (fn [^CompletionStage this other operator _] 124 | (.thenCombineAsync this other operator)) 125 | :with-executor 126 | (fn [^CompletionStage this other operator executor] 127 | (.thenCombineAsync this other operator executor))} 128 | :interface fn->BiFunction 129 | :inner-assertion (fn [_ _]) 130 | :post-assertion #(is (= 2 %))} 131 | {:methods {:raw 132 | (fn [^CompletionStage this other operator _] 133 | (.thenAcceptBoth this other operator)) 134 | :async 135 | (fn [^CompletionStage this other operator _] 136 | (.thenAcceptBothAsync this other operator)) 137 | :with-executor 138 | (fn [^CompletionStage this other operator executor] 139 | (.thenAcceptBothAsync this other operator executor))} 140 | :interface fn->BiConsumer 141 | :inner-assertion (fn [x y] (is (= 1 x)) (is (= 1 y))) 142 | :post-assertion (fn [_])} 143 | {:methods {:raw 144 | (fn [^CompletionStage this other operator _] 145 | (.runAfterBoth this other operator)) 146 | :async 147 | (fn [^CompletionStage this other operator _] 148 | (.runAfterBothAsync this other operator)) 149 | :with-executor 150 | (fn [^CompletionStage this other operator executor] 151 | (.runAfterBothAsync this other operator executor))} 152 | :interface fn2->Runnable 153 | :inner-assertion (fn [_ _]) 154 | :post-assertion (fn [_])}]) 155 | 156 | (defn- test-zip-success [method-info mode executor] 157 | 158 | (let [was-called (atom false) 159 | 160 | method (get-in method-info [:methods mode]) 161 | {:keys [inner-assertion post-assertion] 162 | to-java-interface :interface} method-info 163 | 164 | d1 (d/success-deferred 1) 165 | d2 (d/success-deferred 1) 166 | d3 (method 167 | d1 168 | d2 169 | (to-java-interface 170 | (fn [x y] 171 | (inner-assertion x y) 172 | (reset! was-called true) 173 | (when (and x y) (+ x y)))) 174 | executor)] 175 | 176 | (is (= @d1 1)) 177 | (is (= @d2 1)) 178 | (post-assertion @d3) 179 | (is (= true @was-called)))) 180 | 181 | (defn test-zip-error [method-info mode executor] 182 | 183 | (let [was-called (atom false) 184 | method (get-in method-info [:methods mode]) 185 | {to-java-interface :interface} method-info 186 | 187 | d1 (d/error-deferred (RuntimeException.)) 188 | d2 (d/error-deferred (RuntimeException.)) 189 | d3 (method 190 | d1 191 | d2 192 | (to-java-interface 193 | (fn [_ _] 194 | (reset! was-called true))) 195 | executor)] 196 | 197 | (is (thrown? RuntimeException @d1)) 198 | (is (thrown? RuntimeException @d2)) 199 | (is (thrown? RuntimeException @d3)) 200 | (is (= false @was-called)))) 201 | 202 | 203 | (deftest test-zip-methods 204 | 205 | (let [executor (Executors/newSingleThreadExecutor)] 206 | (testing "zip success" 207 | (dorun (for [method-info zip-method-info 208 | mode [:raw :async :with-executor]] 209 | (test-zip-success method-info mode executor)))) 210 | 211 | (testing "zip error" 212 | (dorun (for [method-info zip-method-info 213 | mode [:raw :async :with-executor]] 214 | (test-zip-error method-info mode executor)))))) 215 | 216 | (def alt-method-info 217 | [{:methods {:raw 218 | (fn [^CompletionStage this other operator _] 219 | (.applyToEither this other operator)) 220 | :async 221 | (fn [^CompletionStage this other operator _] 222 | (.applyToEitherAsync this other operator)) 223 | :with-executor 224 | (fn [^CompletionStage this other operator executor] 225 | (.applyToEitherAsync this other operator executor))} 226 | :interface fn->Function 227 | :inner-assertion #(is (or (= % 1) (= % 2))) 228 | :post-assertion #(is (#{1 2} %))} 229 | 230 | {:methods {:raw 231 | (fn [^CompletionStage this other operator _] 232 | (.acceptEither this other operator)) 233 | :async 234 | (fn [^CompletionStage this other operator _] 235 | (.acceptEitherAsync this other operator)) 236 | :with-executor 237 | (fn [^CompletionStage this other operator executor] 238 | (.acceptEitherAsync this other operator executor))} 239 | :interface fn->Consumer 240 | :inner-assertion #(is (or (= % 1) (= % 2))) 241 | :post-assertion (fn [_])} 242 | 243 | {:methods {:raw 244 | (fn [^CompletionStage this other operator _] 245 | (.runAfterEither this other operator)) 246 | :async 247 | (fn [^CompletionStage this other operator _] 248 | (.runAfterEitherAsync this other operator)) 249 | :with-executor 250 | (fn [^CompletionStage this other operator executor] 251 | (.runAfterEitherAsync this other operator executor))} 252 | :interface fn1->Runnable 253 | :inner-assertion (fn [_]) 254 | :post-assertion (fn [_])}]) 255 | 256 | (defn- test-alt-success [method-info mode executor] 257 | 258 | (let [was-called (atom false) 259 | 260 | method (get-in method-info [:methods mode]) 261 | {:keys [inner-assertion post-assertion] 262 | to-java-interface :interface} method-info 263 | 264 | d1 (d/success-deferred 1) 265 | d2 (d/success-deferred 2) 266 | d3 (method 267 | d1 268 | d2 269 | (to-java-interface 270 | (fn [x] 271 | (inner-assertion x) 272 | (reset! was-called true) 273 | x)) 274 | executor)] 275 | 276 | (is (= @d1 1)) 277 | (is (= @d2 2)) 278 | (post-assertion @d3) 279 | (is (= true @was-called)))) 280 | 281 | (defn test-alt-error [method-info mode executor] 282 | 283 | (let [was-called (atom false) 284 | method (get-in method-info [:methods mode]) 285 | {to-java-interface :interface} method-info 286 | 287 | d1 (d/error-deferred (RuntimeException.)) 288 | d2 (d/error-deferred (RuntimeException.)) 289 | d3 (method 290 | d1 291 | d2 292 | (to-java-interface 293 | (fn [_] 294 | (reset! was-called true))) 295 | executor)] 296 | 297 | (is (thrown? RuntimeException @d1)) 298 | (is (thrown? RuntimeException @d2)) 299 | (is (thrown? RuntimeException @d3)) 300 | (is (= false @was-called)))) 301 | 302 | (deftest test-alt-methods 303 | 304 | (let [executor (Executors/newSingleThreadExecutor)] 305 | (testing "alt success" 306 | (dorun (for [method-info alt-method-info 307 | mode [:raw :async :with-executor]] 308 | (test-alt-success method-info mode executor)))) 309 | 310 | (testing "alt error" 311 | (dorun (for [method-info alt-method-info 312 | mode [:raw :async :with-executor]] 313 | (test-alt-error method-info mode executor)))))) 314 | 315 | 316 | 317 | (def compose-method-info 318 | {:methods {:raw 319 | (fn [^CompletionStage this operator _] 320 | (.thenCompose this operator)) 321 | :async 322 | (fn [^CompletionStage this operator _] 323 | (.thenComposeAsync this operator)) 324 | :with-executor 325 | (fn [^CompletionStage this operator executor] 326 | (.thenComposeAsync this operator executor))} 327 | :interface fn->Function 328 | :inner-assertion #(is (= 1 %)) 329 | :post-assertion #(is (= 2 %))}) 330 | 331 | (defn- test-compose-success [method-info mode executor] 332 | 333 | (let [was-called (atom false) 334 | 335 | method (get-in method-info [:methods mode]) 336 | {:keys [inner-assertion post-assertion] 337 | to-java-interface :interface} method-info 338 | 339 | d1 (d/success-deferred 1) 340 | d2 (method 341 | d1 342 | (to-java-interface 343 | (fn [x] 344 | (inner-assertion x) 345 | (reset! was-called true) 346 | (d/success-deferred 2))) 347 | executor)] 348 | 349 | (is (= @d1 1)) 350 | (post-assertion @d2) 351 | (is (= true @was-called)))) 352 | 353 | 354 | (deftest test-compose 355 | 356 | (let [executor (Executors/newSingleThreadExecutor)] 357 | (testing "compose success" 358 | (dorun (for [method-info [compose-method-info] 359 | mode [:raw :async :with-executor]] 360 | (test-compose-success method-info mode executor)))) 361 | 362 | (testing "compose error" 363 | (dorun (for [method-info [compose-method-info] 364 | mode [:raw :async :with-executor]] 365 | (test-functor-error method-info mode executor)))))) 366 | 367 | (deftest test-compose-into-completable-future 368 | 369 | (testing "deferred can compose into CompletableFuture" 370 | (let [d1 ^CompletionStage (d/success-deferred 10) 371 | d2 (.thenCompose 372 | d1 373 | (fn->Function 374 | (fn [x] (CompletableFuture/completedFuture (inc x)))))] 375 | (is (= @d2 11))))) 376 | 377 | (deftest test-handle 378 | (testing ".handle success" 379 | (let [d1 ^CompletionStage (d/success-deferred 1) 380 | d2 (.handle d1 (fn->BiFunction (fn [x _] (+ 1 x))))] 381 | 382 | (is (= 1 @d1)) 383 | (is (= 2 @d2)))) 384 | 385 | (testing ".handle error" 386 | (let [ex (RuntimeException.) 387 | d1 ^CompletionStage (d/error-deferred ex) 388 | d2 (.handle d1 (fn->BiFunction 389 | (fn [x error] 390 | (is (nil? x)) 391 | (is (#{ex (.getCause ex)} error)) 392 | 2)))] 393 | 394 | (is (thrown? RuntimeException @d1)) 395 | (is (= 2 @d2)))) 396 | 397 | (testing ".handleAsync success" 398 | (let [d1 ^CompletionStage (d/success-deferred 1) 399 | d2 (.handleAsync d1 (fn->BiFunction (fn [x _] (+ 1 x))))] 400 | 401 | (is (= 1 @d1)) 402 | (is (= 2 @d2)))) 403 | 404 | (testing ".handleAsync error" 405 | (let [ex (RuntimeException.) 406 | d1 ^CompletionStage (d/error-deferred ex) 407 | d2 (.handleAsync d1 (fn->BiFunction 408 | (fn [x ^Throwable error] 409 | (is (nil? x)) 410 | (is (#{error (.getCause error)} ex)) 411 | 2)))] 412 | 413 | (is (thrown? RuntimeException @d1)) 414 | (is (= 2 @d2))))) 415 | 416 | (deftest test-exceptionally 417 | (testing ".exceptionally success" 418 | (let [d1 ^CompletionStage (d/success-deferred 1) 419 | d2 (.exceptionally 420 | d1 421 | (fn->Function 422 | (fn [_] 423 | (throw (RuntimeException. 424 | "This should not run")))))] 425 | 426 | (is (= 1 @d1)) 427 | (is (= 1 @d2)))) 428 | 429 | (testing ".exceptionally failure" 430 | (let [base-error (RuntimeException.) 431 | d1 ^CompletionStage (d/error-deferred base-error) 432 | d2 (.exceptionally 433 | d1 434 | (fn->Function 435 | (fn [^Throwable error] 436 | (is (#{error (.getCause error)} base-error)) 437 | 2)))] 438 | 439 | (is (thrown? RuntimeException @d1)) 440 | (is (= 2 @d2))))) 441 | 442 | (deftest test-to-completable-future 443 | (testing ".toCompletableFuture success" 444 | (let [base ^CompletionStage (d/deferred) 445 | target ^CompletableFuture (.toCompletableFuture base)] 446 | 447 | (is (not (.isDone target))) 448 | 449 | (d/success! base 10) 450 | 451 | (is (.isDone target)) 452 | 453 | (is (= 10 (.get target))))) 454 | 455 | (testing ".toCompletableFuture error" 456 | (let [base ^CompletionStage (d/deferred) 457 | target ^CompletableFuture (.toCompletableFuture base)] 458 | 459 | (is (not (.isDone target))) 460 | 461 | (d/error! base (RuntimeException.)) 462 | 463 | (is (.isDone target)) 464 | 465 | (is (thrown? RuntimeException (.getNow target nil)))))) 466 | 467 | 468 | 469 | (def when-complete-methods 470 | [(fn [^CompletionStage this operator _] 471 | (.whenComplete this operator)) 472 | (fn [^CompletionStage this operator _] 473 | (.whenCompleteAsync this operator)) 474 | (fn [^CompletionStage this operator executor] 475 | (.whenCompleteAsync this operator executor))]) 476 | 477 | (defn- test-when-complete-success [method executor] 478 | 479 | (let [was-called (atom false) 480 | 481 | d1 (d/success-deferred 1) 482 | d2 (method 483 | d1 484 | (fn->BiConsumer 485 | (fn [x t] 486 | (is (= 1 x)) 487 | (is (nil? t)) 488 | (reset! was-called true))) 489 | executor)] 490 | 491 | (is (= @d1 1)) 492 | (is (= @d2 1)) 493 | (is (= true @was-called)))) 494 | 495 | (defn- test-when-complete-error [method executor] 496 | 497 | (let [was-called (atom false) 498 | 499 | d1 (d/error-deferred (RuntimeException.)) 500 | d2 (method 501 | d1 502 | (fn->BiConsumer 503 | (fn [x t] 504 | (is (nil? x)) 505 | (is (some? t)) 506 | (reset! was-called true))) 507 | executor)] 508 | 509 | (is (thrown? RuntimeException @d1)) 510 | (is (thrown? RuntimeException @d2)) 511 | (is (= true @was-called))) 512 | 513 | (let [d1 (d/success-deferred 1) 514 | d2 (method 515 | d1 516 | (fn->BiConsumer (fn [_ _] (throw (RuntimeException.)))) 517 | executor)] 518 | 519 | (is (thrown? RuntimeException @d2))) 520 | 521 | (let [error (RuntimeException. "d1 error") 522 | d1 (d/error-deferred error) 523 | d2 (method 524 | d1 525 | (fn->BiConsumer (fn [_ _] 526 | (throw (RuntimeException. "d2 error")))) 527 | executor)] 528 | 529 | (is (thrown-with-msg? RuntimeException #"d1 error" @d2)))) 530 | 531 | (deftest test-when-complete 532 | 533 | (let [executor (Executors/newSingleThreadExecutor)] 534 | (testing "when complete success" 535 | (dorun (for [method when-complete-methods] 536 | (test-when-complete-success method executor)))) 537 | 538 | (testing "when complete error" 539 | (dorun (for [method when-complete-methods] 540 | (test-when-complete-error method executor)))))) 541 | 542 | (deftest test-unwrapping 543 | (testing ".thenApply unwrapping" 544 | (let [d1 ^CompletionStage (d/success-deferred 10) 545 | d2 (.thenApply 546 | d1 547 | (fn->Function 548 | (fn [x] 549 | (d/success-deferred x))))] 550 | (is (d/deferred? @d2)))) 551 | 552 | (testing ".thenCombine unwrapping" 553 | (let [d1 ^CompletionStage (d/success-deferred 10) 554 | d2 (d/success-deferred 20) 555 | d3 (.thenCombine 556 | d1 557 | d2 558 | (fn->BiFunction 559 | (fn [x y] 560 | (d/success-deferred (+ x y)))))] 561 | (is (d/deferred? @d3)))) 562 | 563 | (testing "applyToEither unwrapping" 564 | (let [d1 ^CompletionStage (d/success-deferred 10) 565 | d2 (d/success-deferred 20) 566 | d3 (.applyToEither 567 | d1 568 | d2 569 | (fn->Function 570 | (fn [x] 571 | (d/success-deferred x))))] 572 | (is (d/deferred? @d3)))) 573 | 574 | (testing ".thenCompose unwrapping" 575 | (let [d1 ^CompletionStage (d/success-deferred 10) 576 | d2 (.thenCompose 577 | d1 578 | (fn->Function 579 | (fn [x] 580 | (d/success-deferred (d/success-deferred x)))))] 581 | (is (d/deferred? @d2)))) 582 | 583 | (testing ".handle unwrapping" 584 | (let [d1 ^CompletionStage (d/success-deferred 10) 585 | d2 (.handle 586 | d1 587 | (fn->BiFunction 588 | (fn [x _] 589 | (d/success-deferred (d/success-deferred x)))))] 590 | 591 | (is (d/deferred? @d2)))) 592 | 593 | (testing ".exceptionally unwrapping" 594 | (let [d1 ^CompletionStage (d/error-deferred 10) 595 | d2 (.exceptionally 596 | d1 597 | (fn->Function 598 | (fn [x] 599 | (d/success-deferred (d/success-deferred x)))))] 600 | 601 | (is (d/deferred? @d2))))) 602 | 603 | (instrument-tests-with-dropped-error-detection!) 604 | --------------------------------------------------------------------------------