Harden flaky merge-architectures generative test

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 #{}))

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))
 
@@ -116,14 +119,10 @@
        :else (compare v1 v2)))
    variants))
 
-(defn equal?
-  [v1 v2]
-  (= 0 (compare v1 v2)))
-
 (defn equal-except-architecture?
-  [{arch1 :architecture :as v1} {arch2 :architecture :as v2}]
-  (and (not= arch1 arch2)
-       (equal? (dissoc v1 :architecture) (dissoc v2 :architecture))))
+  [v1 v2]
+  (and (not= (:architecture v1) (:architecture v2))
+       (= (docker/full-tag v1) (docker/full-tag v2))))
 
 (defn combinations
   [base-images jdk-versions distros build-tools architectures]
@@ -179,17 +178,19 @@
                                       (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
-           (= ret-count unique-variants)))
+  :fn   #(let [ret-count    (-> % :ret count)
+               arg-variants (-> % :args :variants)
+               ;; Count the distinct images, ignoring architecture, using the
+               ;; same `docker/full-tag` identity `equal-except-architecture?`
+               ;; merges on -- one source of truth for "same image except arch".
+               unique-images (->> arg-variants
+                                  (map docker/full-tag)
+                                  set count)]
+           ;; We expect one merged variant per distinct image.
+           (= ret-count unique-images)))