diff --git a/.gitignore b/.gitignore index e04714b..744b64a 100644 --- a/.gitignore +++ b/.gitignore @@ -7,3 +7,4 @@ pom.xml.asc *.class /.lein-* /.nrepl-port +/.cpcache diff --git a/deps.edn b/deps.edn new file mode 100644 index 0000000..af9c8e6 --- /dev/null +++ b/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"}}} diff --git a/src/com/gfredericks/test/chuck/clojure_test.cljc b/src/com/gfredericks/test/chuck/clojure_test.cljc index 86f9460..2e1b62a 100644 --- a/src/com/gfredericks/test/chuck/clojure_test.cljc +++ b/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] diff --git a/test/com/gfredericks/test/chuck/clojure_test_output_test.cljc b/test/com/gfredericks/test/chuck/clojure_test_output_test.cljc index afffc6c..f1194b6 100644 --- a/test/com/gfredericks/test/chuck/clojure_test_output_test.cljc +++ b/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]))