Quick experiment to modify clojure.test.check to work with async tests via cljs.core.async promise-chan

check_async.cljs

;   Copyright (c) Rich Hickey, Reid Draper, and contributors.
;   All rights reserved.
;   The use and distribution terms for this software are covered by the
;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;   which can be found in the file epl-v10.html at the root of this distribution.
;   By using this software in any fashion, you are agreeing to be bound by
;   the terms of this license.
;   You must not remove this notice, or any other, from this software.


(ns clojure.test.check-async
  (:require-macros [cljs.core.async.macros :refer [go]])
  (:require [clojure.test.check]
            [clojure.test.check.generators :as gen]
            [clojure.test.check.clojure-test :as ct]
            [clojure.test.check.random :as random]
            [clojure.test.check.rose-tree :as rose]
            [clojure.test.check.impl :refer [get-current-time-millis
                                             exception-like?]]
            [cljs.core.async :refer [<!]]
            [cognitect.anomalies :as anom]))

(declare shrink-loop-ch failure-ch)

(defn- make-rng
  [seed]
  (if seed
    [seed (random/make-random seed)]
    (let [non-nil-seed (get-current-time-millis)]
      [non-nil-seed (random/make-random non-nil-seed)])))

(defn- complete
  [property num-trials seed]
  (ct/report-trial property num-trials num-trials)
  {:result true :num-tests num-trials :seed seed})

(defn- not-falsey-or-exception-or-anomaly?
  "True if the value is not falsy or an exception"
  [value]
  (and value
       (not (exception-like? value))
       (not (::anom/category value))))

(defn quick-check-ch
  "Tests `property` `num-tests` times.
  Takes optional keys `:seed` and `:max-size`. The seed parameter
  can be used to re-run previous tests, as the seed used is returned
  after a test is run. The max-size can be used to control the 'size'
  of generated values. The size will start at 0, and grow up to
  max-size, as the number of tests increases. Generators will use
  the size parameter to bound their growth. This prevents, for example,
  generating a five-thousand element vector on the very first test.

  Examples:

      (def p (for-all [a gen/pos-int] (> (* a a) a)))
      (quick-check 100 p)
  "
  [num-tests property & {:keys [seed max-size] :or {max-size 200}}]
  (let [[created-seed rng] (make-rng seed)
        size-seq (gen/make-size-range-seq max-size)]
    (go (loop [so-far 0
               size-seq size-seq
               rstate rng]
          (if (== so-far num-tests)
            (complete property num-tests created-seed)
            (let [[size & rest-size-seq] size-seq
                  [r1 r2] (random/split rstate)
                  result-map-rose (gen/call-gen property r1 size)
                  result-map (rose/root result-map-rose)
                  result (<! (:result result-map))]
              (if (not-falsey-or-exception-or-anomaly? result)
                (do
                  (ct/report-trial property so-far num-tests)
                  (recur (inc so-far) rest-size-seq r2))
                (<! (failure-ch property result-map-rose so-far size created-seed)))))))))

(defn- smallest-shrink-ch
  [total-nodes-visited depth smallest]
  (go {:total-nodes-visited total-nodes-visited
       :depth               depth
       :result              (<! (:result smallest))
       :smallest            (:args smallest)}))

(defn- shrink-loop-ch
  "Shrinking a value produces a sequence of smaller values of the same type.
  Each of these values can then be shrunk. Think of this as a tree. We do a
  modified depth-first search of the tree:

  Do a non-exhaustive search for a deeper (than the root) failing example.
  Additional rules added to depth-first search:
  * If a node passes the property, you may continue searching at this depth,
  but not backtrack
  * If a node fails the property, search its children
  The value returned is the left-most failing example at the depth where a
  passing example was found."
  [rose-tree]
  (let [shrinks-this-depth (rose/children rose-tree)]
    (go (loop [nodes shrinks-this-depth
               current-smallest (rose/root rose-tree)
               total-nodes-visited 0
               depth 0]
          (if (empty? nodes)
            (smallest-shrink-ch total-nodes-visited depth current-smallest)
            (let [[head & tail] nodes
                  result (<! (:result (rose/root head)))]
              (if (not-falsey-or-exception-or-anomaly? result)
                ;; this node passed the test, so now try testing its right-siblings
                (recur tail current-smallest (inc total-nodes-visited) depth)
                ;; this node failed the test, so check if it has children,
                ;; if so, traverse down them. If not, save this as the best example
                ;; seen now and then look at the right-siblings
                ;; children
                (if-let [children (seq (rose/children head))]
                  (recur children (rose/root head) (inc total-nodes-visited) (inc depth))
                  (recur tail (rose/root head) (inc total-nodes-visited) depth)))))))))

(defn- failure-ch
  [property failing-rose-tree trial-number size seed]
  (go (let [root (rose/root failing-rose-tree)
            result (<! (:result root))
            failing-args (:args root)]

        (ct/report-failure property result trial-number failing-args)

        {:result       result
         :seed         seed
         :failing-size size
         :num-tests    (inc trial-number)
         :fail         (vec failing-args)
         :shrunk       (<! (shrink-loop-ch failing-rose-tree))})))

test.cljs

(ns app.test
  (:require-macros [cljs.core.async.macros :refer [go]])
  (:require [cljs.spec.test.alpha :as stest]
            [cljs.spec.alpha :as s]
            [clojure.test.check-async :as atc]
            [clojure.test.check.properties :as prop :include-macros true]
            [cljs.core.async :refer [<! >! put!]]
            [cognitect.anomalies :as anom]))


(s/check-asserts true)

(def property
  (prop/for-all [props (s/gen :app.view/form.props)]

    (let [ch (a/promise-chan)]

      (try (reagent.core/render
             [app.view/form props]
             (.getElementById js/document "app")
             #(put! ch :success))

        (catch js/Error e
          (put! ch e)))

      (go (<! (a/timeout 1000))
          (>! ch {::anom/message "Timeout"
                  ::anom/category ::anom/interrupted}))

      (go (let [ret (<! ch)]
            (js/console.log ::report.props props)
            (js/console.log ::report.ret ret)))

      ch)))

(atc/quick-check-ch 10 property)