From 76e90bad36dfc406a7d3410c5d2143e4273c70be Mon Sep 17 00:00:00 2001
From: "alonso.torres" <alonso.torres@kaleidos.net>
Date: Thu, 22 Oct 2026 19:57:19 +0200
Subject: [PATCH] :bug: 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
---
 common/src/app/common/schema/test.cljc        | 29 ++++++++++++++---
 common/test/common_tests/runner.cljc          |  1 +
 .../test/common_tests/schema_check_test.cljc  | 31 +++++++++++++++++++
 3 files changed, 57 insertions(+), 4 deletions(-)
 create mode 100644 common/test/common_tests/schema_check_test.cljc

diff --git a/common/src/app/common/schema/test.cljc b/common/src/app/common/schema/test.cljc
index 1ad26ddbc6..446c0c3003 100644
--- a/common/src/app/common/schema/test.cljc
+++ b/common/src/app/common/schema/test.cljc
@@ -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)]
 
diff --git a/common/test/common_tests/runner.cljc b/common/test/common_tests/runner.cljc
index e3a7e3b40f..c0a7ddb71c 100644
--- a/common/test/common_tests/runner.cljc
+++ b/common/test/common_tests/runner.cljc
@@ -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]
diff --git a/common/test/common_tests/schema_check_test.cljc b/common/test/common_tests/schema_check_test.cljc
new file mode 100644
index 0000000000..6cceb58d41
--- /dev/null
+++ b/common/test/common_tests/schema_check_test.cljc
@@ -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]"))))