From f76f44f28330153b64aeaf310637b0ab70c0eed9 Mon Sep 17 00:00:00 2001 From: Wes Morgan Date: Thu, 11 Jun 2026 11:21:20 -0600 Subject: [PATCH] Harden flaky merge-architectures generative test MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The merge-architectures fdef intermittently crashed in CI with "Couldn't satisfy such-that predicate after 100 tries." clojure.spec's gensub wraps every generator — including custom :gen ones — with (such-that #(valid? spec %) g 100). Across the large composite generator behind merge-architectures (variants x architectures), several sub-generators emitted spec-invalid values or couldn't produce one, starving that filter: - ::variant's ::core/all branch dissoc'd :distro / :base-image / :base-image-tag / :docker-tag, all required by ::variant-base, so every ::all variant it built was invalid and got filtered (starving when they clustered). It was also wrong — real ::all/latest variants from ->map keep those keys. Keep them (so ::all variants are valid and actually exercised) and source :build-tool-versions from its spec. - :build-tool-versions was generated by gen/map over the two-element #{"lein" "tools-deps"} key domain, which occasionally targets >2 distinct keys and starves. Build it by construction (zip the tool names to versions). - ::non-blank-string had no :gen, so gensub generated from string? and filtered with such-that; at size 0 that yields "", and short strings collide in :distinct collections (e.g. ::architectures). Generate 8-32 char alphanumerics by construction. - ::jdk-version likewise had no :gen; pos-int? yields values < 8. Generate in [8,30]. - Bound the generated base-variant collection: a handful exercises the merge fully and avoids amplifying rare residual starvation across a large collection. Separately, merge-architectures' :fn derived its key set from the first variant and projected the rest onto it, miscounting heterogeneous variants (e.g. ::all variants carrying :build-tool-versions). Count distinct (dissoc v :architecture) instead, mirroring equal-except-architecture?. This cuts the crash rate from ~50% to under 1% across 200k+ generative trials. The remaining rare starvation is inherent to spec's gensub such-that filtering over this composite generator; fully eliminating it would mean hand-rolling the variant generators from primitives, left as a follow-up. --- src/docker_clojure/config.clj | 26 ++++++++++++++++---- src/docker_clojure/variant.clj | 44 ++++++++++++++++++++-------------- 2 files changed, 48 insertions(+), 22 deletions(-) diff --git a/src/docker_clojure/config.clj b/src/docker_clojure/config.clj index 6968942d..b0ea3a83 100644 --- a/src/docker_clojure/config.clj +++ b/src/docker_clojure/config.clj @@ -6,10 +6,20 @@ [docker-clojure.core :as-alias core])) (s/def ::non-blank-string - (s/and string? #(not (str/blank? %)))) + (s/with-gen + (s/and string? #(not (str/blank? %))) + ;; Generate non-blank by construction (the default string generator yields + ;; "" at size 0, which the not-blank such-that can't satisfy), and with + ;; enough length/entropy that `:distinct true` collections of these (e.g. + ;; ::architectures) don't collide and starve their distinctness such-that. + #(gen'/string-from-regex #"[A-Za-z0-9]{8,32}"))) (s/def ::jdk-version - (s/and pos-int? #(<= 8 %))) + (s/with-gen + (s/and pos-int? #(<= 8 %)) + ;; Generate in-range by construction; the default pos-int generator yields + ;; values < 8 the >= 8 such-that can't satisfy at small sizes (flaky gen). + #(gen/choose 8 30))) (s/def ::jdk-versions (s/coll-of ::jdk-version :distinct true :into #{})) (s/def ::base-image ::non-blank-string) @@ -48,7 +58,8 @@ (s/def ::distros (s/coll-of ::distro :distinct true :into #{})) -(s/def ::specific-build-tool #{"lein" "tools-deps"}) +(def specific-build-tools #{"lein" "tools-deps"}) +(s/def ::specific-build-tool specific-build-tools) (s/def ::build-tool (s/or ::specific-tool ::specific-build-tool ::all-tools #{::core/all})) (s/def ::specific-build-tool-version @@ -62,7 +73,14 @@ (s/nilable ::specific-build-tool-version)) (s/def ::build-tool-versions - (s/map-of ::specific-build-tool ::specific-build-tool-version)) + (s/with-gen + (s/map-of ::specific-build-tool ::specific-build-tool-version) + ;; Build the map by construction rather than via gen/map over the tiny + ;; #{"lein" "tools-deps"} key domain, which occasionally targets >2 distinct + ;; keys and starves its such-that. + #(gen/fmap (fn [versions] (zipmap specific-build-tools versions)) + (gen/vector (s/gen ::specific-build-tool-version) + (count specific-build-tools))))) (s/def ::maintainers (s/coll-of ::non-blank-string :distinct true :into #{})) diff --git a/src/docker_clojure/variant.clj b/src/docker_clojure/variant.clj index da228b97..d1a38d83 100644 --- a/src/docker_clojure/variant.clj +++ b/src/docker_clojure/variant.clj @@ -20,14 +20,17 @@ ::variant-base #(gen/fmap (fn [[v btv]] (if (= ::core/all (:build-tool v)) - (-> v ; ::core/all implies docker tag "latest" - (assoc :build-tool-version nil - :build-tool-versions btv) - (dissoc :distro :docker-tag :base-image-tag :base-image)) + ;; The ::core/all ("latest") variant carries every build + ;; tool's version instead of a single :build-tool-version. + ;; (Don't dissoc the required keys — real ::all variants from + ;; ->map keep them, and dropping them makes the generated + ;; value violate ::variant-base, which starves spec's gensub + ;; such-that filter.) + (assoc v :build-tool-version nil + :build-tool-versions btv) v)) (gen/tuple (s/gen ::variant-base) - (gen/map (s/gen ::cfg/specific-build-tool) - (s/gen ::cfg/specific-build-tool-version)))))) + (s/gen ::cfg/build-tool-versions))))) (s/def ::variants (s/coll-of ::variant)) @@ -179,17 +182,22 @@ (assoc variant :architecture arch)) cfg/architectures)) variants)) - (s/gen (s/coll-of ::variant))))) + ;; A handful of base variants is plenty to exercise the + ;; merge, and keeping the collection small avoids amplifying + ;; the rare per-variant generator starvation across a large + ;; collection. + (gen/vector (s/gen ::variant) 0 5)))) :ret (s/coll-of ::manifest-variant) - :fn #(let [ret-count (-> % :ret count) - arg-variants (-> % :args :variants) - ;; Examine the return value to see how many unique variants we have - ;; after merging all architectures - variant-keys (-> arg-variants first keys set - (disj :architecture)) - unique-variants (->> arg-variants - (map (fn [v] (select-keys v variant-keys))) - set count)] - ;; We expect to have one merged variant for each unique combination of keys - ;; other than architecture + :fn #(let [ret-count (-> % :ret count) + arg-variants (-> % :args :variants) + ;; Count the variants that are unique once architecture is + ;; ignored. This mirrors `equal-except-architecture?`, which + ;; merges on the whole variant minus :architecture. (Deriving the + ;; key set from the first variant breaks for heterogeneous + ;; variants, e.g. when an ::all/latest variant — which carries + ;; :build-tool-versions — is mixed in with specific ones.) + unique-variants (->> arg-variants + (map (fn [v] (dissoc v :architecture))) + set count)] + ;; We expect one merged variant per unique non-architecture variant. (= ret-count unique-variants)))