CLJS-2845: [spec] generate random subsets of or'd required keys in map specs

Author: mfikes

src/main/cljs/cljs/spec/alpha.cljs

@@ -378,6 +378,35 @@
       (explain* pred path (if-let [name (spec-name pred)] (conj via name) via) in v)
       [{:path path :pred form :val v :via via :in in}])))
 
+(declare ^{:arglists '([s] [min-count s])} or-k-gen
+         ^{:arglists '([s])} and-k-gen)
+
+(defn- k-gen
+  "returns a generator for form f, which can be a keyword or a list
+  starting with 'or or 'and."
+  [f]
+  (cond
+    (keyword? f)       (gen/return f)
+    (= 'or  (first f)) (or-k-gen 1 (rest f))
+    (= 'and (first f)) (and-k-gen (rest f))))
+
+(defn- or-k-gen
+  "returns a tuple generator made up of generators for a random subset
+  of min-count (default 0) to all elements in s."
+  ([s] (or-k-gen 0 s))
+  ([min-count s]
+   (gen/bind (gen/tuple
+               (gen/choose min-count (count s))
+               (gen/shuffle (map k-gen s)))
+     (fn [[n gens]]
+       (apply gen/tuple (take n gens))))))
+
+(defn- and-k-gen
+  "returns a tuple generator made up of generators for every element
+  in s."
+  [s]
+  (apply gen/tuple (map k-gen s)))
+
 (defn ^:skip-wiki map-spec-impl
   "Do not call this directly, use 'spec' with a map argument"
   [{:keys [req-un opt-un keys-pred pred-exprs opt-keys req-specs req req-keys opt-specs pred-forms opt gfn]
@@ -438,21 +467,26 @@
         (if gfn
           (gfn)
           (let [rmap (inck rmap id)
-                gen (fn [k s] (gensub s overrides (conj path k) rmap k))
+                rgen (fn [k s] [k (gensub s overrides (conj path k) rmap k)])
                 ogen (fn [k s]
                        (when-not (recur-limit? rmap id path k)
                          [k (gen/delay (gensub s overrides (conj path k) rmap k))]))
-                req-gens (map gen req-keys req-specs)
-                opt-gens (remove nil? (map ogen opt-keys opt-specs))]
-            (when (every? identity (concat req-gens opt-gens))
-              (let [reqs (zipmap req-keys req-gens)
-                    opts (into {} opt-gens)]
-                (gen/bind (gen/choose 0 (count opts))
-                          #(let [args (concat (seq reqs) (when (seq opts) (shuffle (seq opts))))]
-                            (->> args
-                                 (take (c/+ % (count reqs)))
-                                 (apply concat)
-                                 (apply gen/hash-map)))))))))
+                reqs (map rgen req-keys req-specs)
+                opts (remove nil? (map ogen opt-keys opt-specs))]
+            (when (every? identity (concat (map second reqs) (map second opts)))
+              (gen/bind
+                (gen/tuple
+                  (and-k-gen req)
+                  (or-k-gen opt)
+                  (and-k-gen req-un)
+                  (or-k-gen opt-un))
+                (fn [[req-ks opt-ks req-un-ks opt-un-ks]]
+                  (let [qks (flatten (concat req-ks opt-ks))
+                        unqks (map (comp keyword name) (flatten (concat req-un-ks opt-un-ks)))]
+                    (->> (into reqs opts)
+                      (filter #((set (concat qks unqks)) (first %)))
+                      (apply concat)
+                      (apply gen/hash-map)))))))))
       (with-gen* [_ gfn] (map-spec-impl (assoc argm :gfn gfn)))
       (describe* [_] (cons `keys
                            (cond-> []

src/main/cljs/cljs/spec/gen/alpha.cljs

@@ -8,7 +8,7 @@
 
 (ns cljs.spec.gen.alpha
   (:refer-clojure :exclude [boolean cat hash-map list map not-empty set vector
-                            char double int keyword symbol string uuid delay])
+                            char double int keyword symbol string uuid delay shuffle])
   (:require-macros [cljs.core :as c]
                    [cljs.spec.gen.alpha :as gen :refer [dynaload lazy-combinators lazy-prims]])
   (:require [cljs.core :as c])
@@ -69,7 +69,7 @@
 
 (lazy-combinators hash-map list map not-empty set vector vector-distinct fmap elements
   bind choose one-of such-that tuple sample return
-  large-integer* double* frequency)
+  large-integer* double* frequency shuffle)
 
 (lazy-prims any any-printable boolean char char-alpha char-alphanumeric char-ascii double
   int keyword keyword-ns large-integer ratio simple-type simple-type-printable
@@ -160,7 +160,7 @@ gen-builtins
               :b (gen-for-pred keyword?)}
         opts {:c (gen-for-pred string?)}]
     (generate (bind (choose 0 (count opts))
-                #(let [args (concat (seq reqs) (shuffle (seq opts)))]
+                #(let [args (concat (seq reqs) (c/shuffle (seq opts)))]
                   (->> args
                     (take (+ % (count reqs)))
                     (mapcat identity)

src/test/cljs/cljs/spec_test.cljs

@@ -312,6 +312,52 @@
   (is (= ::ABC (s/def ::ABC nil)))
   (is (nil? (s/get-spec ::ABC))))
 
+;; TODO replace this with a generative test once we have specs for s/keys
+(deftest map-spec-generators
+  (s/def ::a nat-int?)
+  (s/def ::b boolean?)
+  (s/def ::c keyword?)
+  (s/def ::d double?)
+  (s/def ::e inst?)
+
+  (is (= #{[::a]
+           [::a ::b]
+           [::a ::b ::c]
+           [::a ::c]}
+        (->> (s/exercise (s/keys :req [::a] :opt [::b ::c]) 100)
+          (map (comp sort keys first))
+          (into #{}))))
+
+  (is (= #{[:a]
+           [:a :b]
+           [:a :b :c]
+           [:a :c]}
+        (->> (s/exercise (s/keys :req-un [::a] :opt-un [::b ::c]) 100)
+          (map (comp sort keys first))
+          (into #{}))))
+
+  (is (= #{[::a ::b]
+           [::a ::b ::c ::d]
+           [::a ::b ::c ::d ::e]
+           [::a ::b ::c ::e]
+           [::a ::c ::d]
+           [::a ::c ::d ::e]
+           [::a ::c ::e]}
+        (->> (s/exercise (s/keys :req [::a (or ::b (and ::c (or ::d ::e)))]) 200)
+          (map (comp vec sort keys first))
+          (into #{}))))
+
+  (is (= #{[:a :b]
+           [:a :b :c :d]
+           [:a :b :c :d :e]
+           [:a :b :c :e]
+           [:a :c :d]
+           [:a :c :d :e]
+           [:a :c :e]}
+        (->> (s/exercise (s/keys :req-un [::a (or ::b (and ::c (or ::d ::e)))]) 200)
+          (map (comp vec sort keys first))
+          (into #{})))))
+
 (s/fdef foo.bar/cljs-2275
   :args (s/cat :k keyword?)
   :ret  string?)