Print seed in checking attempt 2

.gitignore

@@ -7,3 +7,4 @@ pom.xml.asc
 *.class
 /.lein-*
 /.nrepl-port
+/.cpcache

deps.edn

@@ -0,0 +1,5 @@
+{:paths ["src" "resources"]
+ :deps {org.clojure/test.check {:mvn/version "1.1.0"}
+        clj-time/clj-time {:mvn/version "0.15.2"}
+        com.andrewmcveigh/cljs-time {:mvn/version "0.5.2"}
+        instaparse/instaparse {:mvn/version "1.4.10"}}}

src/com/gfredericks/test/chuck/clojure_test.cljc

@@ -81,22 +81,72 @@
   (cond (map? num-tests-or-options)     (:num-tests num-tests-or-options tc.clojure-test/*default-test-count*)
         (integer? num-tests-or-options) num-tests-or-options))
 
+(defn get-current-time-millis
+  "Internal"
+  []
+  #?(:clj  (System/currentTimeMillis)
+     :cljs (.valueOf (js/Date.))))
+
 (defn options [num-tests-or-options]
-  (cond (map? num-tests-or-options)     (dissoc num-tests-or-options :num-tests)
-        (integer? num-tests-or-options) {}))
+  (-> (cond (map? num-tests-or-options)     (dissoc num-tests-or-options :num-tests)
+            (integer? num-tests-or-options) {})
+      (update :seed #(or % (get-current-time-millis)))))
+
+(defn counting-reporter-fn [f atm]
+  (fn [{:keys [num-tests] :as r}]
+    (when (integer? num-tests)
+      (swap! atm max num-tests))
+    (when f
+      (f r))))
+
+(defn -exception-thrown-report
+  "Internal"
+  [property e trial-number seed start-time reporter-fn]
+  (let [failed-after-ms (- (get-current-time-millis) start-time)]
+    {:type :failure
+     :failed-after-ms failed-after-ms
+     :num-tests trial-number
+     :pass? false
+     :property property
+     :result e
+     :result-data {:clojure.test.check.properties/error e}
+     :seed seed}))
+
+(defn -report-generator-exception
+  "Internal"
+  [{:keys [seed current-iteration]}]
+  (with-test-out*
+    #(println (str "\n\nError thrown by test during iteration " current-iteration
+                   "\nSeed: " seed))))
 
 (defmacro qc-and-report-exception
   [final-reports num-tests-or-options bindings & body]
   `(report-exception-or-shrunk
      (let [num-tests-or-options# ~num-tests-or-options
-           final-reports# ~final-reports]
-       (apply tc/quick-check
-         (times num-tests-or-options#)
-         (prop/for-all ~bindings
-           (let [reports# (capture-reports ~@body)]
-             (swap! final-reports# save-to-final-reports reports#)
-             (pass? reports#)))
-         (apply concat (options num-tests-or-options#))))))
+           final-reports# ~final-reports
+           so-far-atm# (atom 0)
+           options-map# (-> (options num-tests-or-options#)
+                            (update :reporter-fn counting-reporter-fn so-far-atm#))
+           with-captured-reports# (fn [f#]
+                                    (let [reports# (capture-reports (f#))]
+                                      (swap! final-reports# save-to-final-reports reports#)
+                                      reports#))
+           property# (prop/for-all ~bindings
+                       (pass? (with-captured-reports# (fn [] (do ~@body)))))
+           start-time# (get-current-time-millis)]
+       (try (apply tc/quick-check
+             (times num-tests-or-options#)
+             property#
+             (apply concat options-map#))
+            (catch #?(:clj  Throwable
+                      :cljs :default) e#
+              (let [reporter-fn# (:reporter-fn options-map#)
+                    r# (-exception-thrown-report
+                         property# e# (inc @so-far-atm#) (:seed options-map#)
+                         start-time# reporter-fn#)]
+                (with-captured-reports#
+                  #(reporter-fn# r#))
+                r#))))))
 
 (defn -testing
   [name func]

test/com/gfredericks/test/chuck/clojure_test_output_test.cljc

@@ -93,6 +93,45 @@
               (get-in tc-report path))))
       (is (= [{'i 0}] (get-in tc-report [:shrunk :smallest]))))))
 
+;; https://github.com/gfredericks/test.chuck/issues/78
+(deftest an-error-during-gen-test
+  (try (checking "preamble" {:seed 123456}
+         [_ (gen/return nil)
+          :let [_ (throw (ex-info "error during gen" {}))]]
+         (is true))
+       (catch #?(:cljs :default :clj Throwable) e
+         (is false e))))
+
+(deftest checking-prints-seed-on-gen-error-test
+  (let [[test-results all-out] (capture-report-counters-and-out #'an-error-during-gen-test)
+        ;; skip test preamble
+        [_ out] (str/split all-out
+                           #".*preamble\n"
+                           2)
+        _ (assert out (pr-str {:test-results test-results
+                               :all-out all-out}))
+        ;; report is printed after `testing`
+        tc-report (try (edn/read-string
+                         {:readers (assoc default-data-readers
+                                          'error #(-> %
+                                                      (assoc ::error-tag true)))}
+                         out)
+                       (catch #?(:cljs :default :clj Exception) e
+                         (println (pr-str {:out out
+                                           :all-out all-out}))
+                         (throw e)))
+        error-map-msg-key #?(:clj :cause :cljs :message)]
+    (testing "clojure.test reporting"
+      (is (= test-results {:test 1, :pass 0, :fail 1, :error 0})))
+    (testing "thrown exception"
+      (is (false? (:pass? tc-report))
+          (pr-str tc-report))
+      (is (get-in tc-report [:result ::error-tag]))
+      (is (get-in tc-report [:result-data :clojure.test.check.properties/error ::error-tag]))
+      (is (= 123456 (:seed tc-report)))
+      (is (not (contains? tc-report :shrunk))))))
+
 (defn test-ns-hook []
   (test-vars [#'failure-output-test
-              #'error-output-test]))
+              #'error-output-test
+              #'checking-prints-seed-on-gen-error-test]))