🐛 Honor generative test size and seed options

Preserve explicit quick-check options and read PENPOT_GEN_NUM and
PENPOT_GEN_SEED when callers leave them unset. Print the final shrunk
counterexample in full so failures can be replayed.

The new regressions failed before the fix and now pass on the JVM.
Common lint and the full JVM/JS suites pass. Format checks pass for
these files; the in-progress Phase 4 harness remains outside this commit.

AI-assisted-by: GPT-6
This commit is contained in:
alonso.torres 2026-10-22 19:57:19 +02:00
parent fe80b4d3e4
commit 76e90bad36
3 changed files with 57 additions and 4 deletions

View File

@ -56,8 +56,12 @@
(str "(pass=TRUE, tests=" (:num-tests params) ", seed=" (:seed params) ", elapsed=" time "ms)"))))
(defmethod ct/report #?(:clj ::thrunk :cljs [:cljs.test/default ::thrunk])
[_]
nil)
[{:keys [::params]}]
(println "Shrunk generative case:")
(binding [*print-length* nil *print-level* nil]
(prn (merge (select-keys params [:seed])
(select-keys (:shrunk params) [:smallest :total-nodes-visited
:time-shrinking-ms])))))
(defmethod ct/report #?(:clj ::trial :cljs [:cljs.test/default ::trial])
[_]
@ -86,9 +90,26 @@
[bindings & body]
`(tp/for-all ~bindings ~@body))
(defn- environment-number
[name]
(when-let [value #?(:clj (System/getenv name)
:cljs (some-> js/globalThis .-process .-env (aget name)))]
(let [number #?(:clj (parse-long value) :cljs (js/Number value))]
(when-not (and (integer? number) (pos? number))
(throw (ex-info (str name " must be a positive integer")
{:variable name :value value})))
number)))
(defn check!
[p & {:keys [num] :or {num 20} :as options}]
(let [result (tc/quick-check num p (assoc options :reporter-fn default-reporter-fn :max-size 50))
"Check a property with reproducible size and seed. PENPOT_GEN_NUM and
PENPOT_GEN_SEED override the defaults; explicit options take precedence."
[p & {:as options}]
(let [num (or (:num options) (environment-number "PENPOT_GEN_NUM") 20)
seed (or (:seed options) (environment-number "PENPOT_GEN_SEED"))
options (cond-> (merge {:max-size 50 :reporter-fn default-reporter-fn}
(dissoc options :num))
seed (assoc :seed seed))
result (tc/quick-check num p options)
pass? (:pass? result)
total-tests (:num-tests result)]

View File

@ -102,6 +102,7 @@
[common-tests.path-names-test]
[common-tests.path-names-tree-test]
[common-tests.record-test]
[common-tests.schema-check-test]
[common-tests.schema-test]
[common-tests.spec-test]
[common-tests.svg-path-test]

View File

@ -0,0 +1,31 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns common-tests.schema-check-test
(:require
[app.common.schema.test :as smt]
[clojure.string :as str]
[clojure.test :as t]
[clojure.test.check.generators :as gen]))
(t/deftest check-preserves-size-and-seed
(let [seen (atom [])
property (smt/for [size (gen/sized gen/return)]
(swap! seen conj size)
true)
run (fn []
(reset! seen [])
(smt/check! property :num 4 :max-size 1 :seed 712)
@seen)]
(t/is (= (run) (run)))
(t/is (every? zero? @seen))))
(t/deftest failure-reports-the-shrunk-case
(let [output (with-out-str
(smt/default-reporter-fn
{:type :shrunk :seed 712 :shrunk {:smallest [10]}}))]
(t/is (str/includes? output "712"))
(t/is (str/includes? output ":smallest [10]"))))