Codebase list test-check-clojure / f0ce10a
Add gen/let, a macro that does fmap & bind Gary Fredericks 8 years ago
2 changed file(s) with 174 addition(s) and 110 deletion(s). Raw diff Collapse all Expand all
+155
-110
src/main/clojure/clojure/test/check/generators.cljc less more
1010 (:refer-clojure :exclude [int vector list hash-map map keyword
1111 char boolean byte bytes sequence
1212 shuffle not-empty symbol namespace
13 set sorted-set uuid double])
13 set sorted-set uuid double let])
1414 (:require [#?(:clj clojure.core :cljs cljs.core) :as core]
1515 [clojure.test.check.random :as random]
1616 [clojure.test.check.rose-tree :as rose]
5757 [{h :gen} k]
5858 (make-gen
5959 (fn [rnd size]
60 (let [[r1 r2] (random/split rnd)
60 (core/let [[r1 r2] (random/split rnd)
6161 inner (h r1 size)
6262 {result :gen} (k inner)]
6363 (result r2 size)))))
6767 of random number generators."
6868 [rr]
6969 (lazy-seq
70 (let [[r1 r2] (random/split rr)]
70 (core/let [[r1 r2] (random/split rr)]
7171 (cons r1
7272 (lazy-random-states r2)))))
7373
133133 "Return a sequence of realized values from `generator`."
134134 ([generator] (sample-seq generator 100))
135135 ([generator max-size]
136 (let [r (random/make-random)
136 (core/let [r (random/make-random)
137137 size-seq (make-size-range-seq max-size)]
138138 (core/map #(rose/root (call-gen generator %1 %2))
139139 (lazy-random-states r)
155155 ([generator]
156156 (generate generator 30))
157157 ([generator size]
158 (let [rng (random/make-random)]
158 (core/let [rng (random/make-random)]
159159 (rose/root (call-gen generator rng size)))))
160160
161161
190190 :post [(integer? %)]}
191191 ;; Use -' on width to maintain accuracy with overflow protection.
192192 #?(:clj
193 (let [width (-' upper lower -1)]
193 (core/let [width (-' upper lower -1)]
194194 ;; Preserve long precision if the width is in the long range. Otherwise, we must accept
195195 ;; less precision because doubles don't have enough bits to preserve long equivalence at
196196 ;; extreme values.
215215 [sized-gen]
216216 (make-gen
217217 (fn [rnd size]
218 (let [sized-gen (sized-gen size)]
218 (core/let [sized-gen (sized-gen size)]
219219 (call-gen sized-gen rnd size)))))
220220
221221 ;; Combinators and helpers
225225 "Create a new generator with `size` always bound to `n`."
226226 [n generator]
227227 (assert (generator? generator) "Second arg to resize must be a generator")
228 (let [{:keys [gen]} generator]
228 (core/let [{:keys [gen]} generator]
229229 (make-gen
230230 (fn [rnd _size]
231231 (gen rnd n)))))
246246 `lower` to `upper`, inclusive.")
247247 [lower upper]
248248 ;; cast to long to support doubles as arguments per TCHECK-73
249 (let #?(:clj
249 (core/let #?(:clj
250250 [lower (long lower)
251251 upper (long upper)]
252252
254254 [])
255255 (make-gen
256256 (fn [rnd _size]
257 (let [value (rand-range rnd lower upper)]
257 (core/let [value (rand-range rnd lower upper)]
258258 (rose/filter
259259 #(and (>= % lower) (<= % upper))
260260 (int-rose-tree value)))))))
277277
278278 (defn- pick
279279 [[h & tail] n]
280 (let [[chance gen] h]
280 (core/let [[chance gen] h]
281281 (if (<= n chance)
282282 gen
283283 (recur tail (- n chance)))))
295295 (assert (every? (fn [[x g]] (and (number? x) (generator? g)))
296296 pairs)
297297 "Arg to frequency must be a list of [num generator] pairs")
298 (let [total (apply + (core/map first pairs))]
298 (core/let [total (apply + (core/map first pairs))]
299299 (gen-bind (choose 1 total)
300300 #(pick pairs (rose/root %)))))
301301
308308 "
309309 [coll]
310310 (assert (seq coll) "elements cannot be called with an empty collection")
311 (let [v (vec coll)]
311 (core/let [v (vec coll)]
312312 (gen-bind (choose 0 (dec (count v)))
313313 #(gen-pure (rose/fmap v %)))))
314314
317317 (if (zero? tries-left)
318318 (throw (ex-info (str "Couldn't satisfy such-that predicate after "
319319 max-tries " tries.") {}))
320 (let [[r1 r2] (random/split rng)
320 (core/let [[r1 r2] (random/split rng)
321321 value (call-gen gen r1 size)]
322322 (if (pred (rose/root value))
323323 (rose/filter pred value)
484484 toward the original collection: `coll`. `coll` will be turned into a vector,
485485 if it's not already."
486486 [coll]
487 (let [index-gen (choose 0 (dec (count coll)))]
487 (core/let [index-gen (choose 0 (dec (count coll)))]
488488 (fmap #(reduce swap (vec coll) %)
489489 ;; a vector of swap instructions, with count between
490490 ;; zero and 2 * count. This means that the average number
516516 "
517517 [& kvs]
518518 (assert (even? (count kvs)))
519 (let [ks (take-nth 2 kvs)
519 (core/let [ks (take-nth 2 kvs)
520520 vs (take-nth 2 (rest kvs))]
521521 (assert (every? generator? vs)
522522 "Value args to hash-map must be generators")
567567 (rose/shrink #(into empty-coll %&)))
568568
569569 :else
570 (let [[rng1 rng2] (random/split rng)
570 (core/let [[rng1 rng2] (random/split rng)
571571 rose (call-gen gen rng1 size)
572572 root (rose/root rose)
573573 k (key-fn root)]
591591
592592 Note that this is not a generator, it is just a utility function."
593593 [rng coll]
594 (let [empty-coll (empty coll)
594 (core/let [empty-coll (empty coll)
595595 v (vec coll)
596596 card (count coll)
597597 dec-card (dec card)]
598598 (into empty-coll
599599 (first
600600 (reduce (fn [[v rng] idx]
601 (let [[rng1 rng2] (random/split rng)
601 (core/let [[rng1 rng2] (random/split rng)
602602 swap-idx (rand-range rng1 idx dec-card)]
603603 [(swap v [idx swap-idx]) rng2]))
604604 [v rng]
607607 (defn ^:private coll-distinct-by
608608 [empty-coll key-fn allows-dupes? ordered? gen
609609 {:keys [num-elements min-elements max-elements max-tries] :or {max-tries 10}}]
610 (let [shuffle-fn (if ordered?
610 (core/let [shuffle-fn (if ordered?
611611 the-shuffle-fn
612612 (fn [_rng coll] coll))
613613 hard-min-elements (or num-elements min-elements 1)]
614614 (if num-elements
615 (let [size-pred #(= num-elements (count %))]
615 (core/let [size-pred #(= num-elements (count %))]
616616 (assert (and (nil? min-elements) (nil? max-elements)))
617617 (make-gen
618618 (fn [rng gen-size]
625625 size-pred)
626626 (coll-distinct-by* empty-coll key-fn shuffle-fn gen rng gen-size
627627 num-elements hard-min-elements max-tries)))))
628 (let [min-elements (or min-elements 0)
629 size-pred (if max-elements
630 #(<= min-elements (count %) max-elements)
631 #(<= min-elements (count %)))]
628 (core/let [min-elements (or min-elements 0)
629 size-pred (if max-elements
630 #(<= min-elements (count %) max-elements)
631 #(<= min-elements (count %)))]
632632 (gen-bind
633633 (if max-elements
634634 (choose min-elements max-elements)
635635 (sized #(choose min-elements (+ min-elements %))))
636636 (fn [num-elements-rose]
637 (let [num-elements (rose/root num-elements-rose)]
637 (core/let [num-elements (rose/root num-elements-rose)]
638638 (make-gen
639639 (fn [rng gen-size]
640640 (rose/filter
817817 (cond-> (zero? min) (abs)))]
818818 (if (<= min res max)
819819 res
820 (let [res' (- res)]
820 (core/let [res' (- res)]
821821 (if (<= min res' max)
822822 res'
823823 (recur #?(:clj (bit-shift-right res 1)
831831 "Like large-integer*, but assumes range includes zero."
832832 [min max]
833833 (sized (fn [size]
834 (let [size (core/max size 1) ;; no need to worry about size=0
834 (core/let [size (core/max size 1) ;; no need to worry about size=0
835835 max-bit-count (core/min size #?(:clj 64 :cljs 54))]
836836 (gen-fmap (fn [rose]
837 (let [[bit-count x] (rose/root rose)]
837 (core/let [[bit-count x] (rose/root rose)]
838838 (int-rose-tree (long->large-integer bit-count x min max))))
839839 (tuple (choose 1 max-bit-count)
840840 gen-raw-long))))))
848848
849849 Both :min and :max are optional."
850850 [{:keys [min max]}]
851 (let [min (or min MIN_INTEGER)
851 (core/let [min (or min MIN_INTEGER)
852852 max (or max MAX_INTEGER)]
853853 (assert (<= min max))
854854 (such-that #(<= min % max)
953953 :cljs
954954 (if (zero? x)
955955 -1023
956 (let [x (Math/abs x)
957
958 res
959 (Math/floor (* (Math/log x) (.-LOG2E js/Math)))
960
961 t (scalb x (- res))]
956 (core/let [x (Math/abs x)
957
958 res
959 (Math/floor (* (Math/log x) (.-LOG2E js/Math)))
960
961 t (scalb x (- res))]
962962 (cond (< t 1) (dec res)
963963 (<= 2 t) (inc res)
964964 :else res)))))
969969 doubles within the given bounds."
970970 [lower-bound upper-bound]
971971 (letfn [(gen-exp [lb ub]
972 (sized (fn [size]
973 (let [qs8 (bit-shift-left 1 (quot (min 200 size) 8))]
974 (cond (<= lb 0 ub)
975 (choose (max lb (- qs8)) (min ub qs8))
976
977 (< ub 0)
978 (choose (max lb (- ub qs8)) ub)
979
980 :else
981 (choose lb (min ub (+ lb qs8))))))))]
972 (sized (fn [size]
973 (core/let [qs8 (bit-shift-left 1 (quot (min 200 size) 8))]
974 (cond (<= lb 0 ub)
975 (choose (max lb (- qs8)) (min ub qs8))
976
977 (< ub 0)
978 (choose (max lb (- ub qs8)) ub)
979
980 :else
981 (choose lb (min ub (+ lb qs8))))))))]
982982 (if (and (nil? lower-bound)
983983 (nil? upper-bound))
984984 (tuple (gen-exp -1023 1023)
985985 (elements [1.0 -1.0]))
986 (let [lower-bound (or lower-bound MIN_NEG_VALUE)
987 upper-bound (or upper-bound MAX_POS_VALUE)
988 lbexp (max -1023 (get-exponent lower-bound))
989 ubexp (max -1023 (get-exponent upper-bound))]
986 (core/let [lower-bound (or lower-bound MIN_NEG_VALUE)
987 upper-bound (or upper-bound MAX_POS_VALUE)
988 lbexp (max -1023 (get-exponent lower-bound))
989 ubexp (max -1023 (get-exponent upper-bound))]
990990 (cond (<= 0.0 lower-bound)
991991 (tuple (gen-exp lbexp ubexp)
992992 (return 1.0))
10101010 range."
10111011 [exp sign]
10121012 (if (neg? sign)
1013 (let [[low high] (block-bounds exp (- sign))]
1013 (core/let [[low high] (block-bounds exp (- sign))]
10141014 [(- high) (- low)])
10151015 (if (= -1023 exp)
10161016 [0.0 (-> 1.0 (scalb 52) dec (scalb -1074))]
10221022 {:pre [(or (nil? lower-bound)
10231023 (nil? upper-bound)
10241024 (<= lower-bound upper-bound))]}
1025 (let [pred (if lower-bound
1026 (if upper-bound
1027 #(<= lower-bound % upper-bound)
1028 #(<= lower-bound %))
1029 (if upper-bound
1030 #(<= % upper-bound)))
1031
1032 gen
1033 (fmap (fn [[[exp sign] significand]]
1034 (let [ ;; 1.0 <= base < 2.0
1035 base (inc (/ significand (Math/pow 2 52)))
1036 x (-> base (scalb exp) (* sign))]
1037 (if (or (nil? pred) (pred x))
1038 x
1039 ;; Scale things a bit when we have a partial range
1040 ;; to deal with. It won't be great for generating
1041 ;; simple numbers, but oh well.
1042 (let [[low high] (block-bounds exp sign)
1043
1044 block-lb (cond-> low lower-bound (max lower-bound))
1045 block-ub (cond-> high upper-bound (min upper-bound))
1046 x (+ block-lb (* (- block-ub block-lb) (- base 1)))]
1047 (-> x (min block-ub) (max block-lb))))))
1048 (tuple (double-exp-and-sign lower-bound upper-bound)
1049 backwards-shrinking-significand))]
1025 (core/let [pred (if lower-bound
1026 (if upper-bound
1027 #(<= lower-bound % upper-bound)
1028 #(<= lower-bound %))
1029 (if upper-bound
1030 #(<= % upper-bound)))
1031
1032 gen
1033 (fmap (fn [[[exp sign] significand]]
1034 (core/let [ ;; 1.0 <= base < 2.0
1035 base (inc (/ significand (Math/pow 2 52)))
1036 x (-> base (scalb exp) (* sign))]
1037 (if (or (nil? pred) (pred x))
1038 x
1039 ;; Scale things a bit when we have a partial range
1040 ;; to deal with. It won't be great for generating
1041 ;; simple numbers, but oh well.
1042 (core/let [[low high] (block-bounds exp sign)
1043
1044 block-lb (cond-> low lower-bound (max lower-bound))
1045 block-ub (cond-> high upper-bound (min upper-bound))
1046 x (+ block-lb (* (- block-ub block-lb) (- base 1)))]
1047 (-> x (min block-ub) (max block-lb))))))
1048 (tuple (double-exp-and-sign lower-bound upper-bound)
1049 backwards-shrinking-significand))]
10501050 ;; wrapping in the such-that is necessary for staying in bounds
10511051 ;; during shrinking
10521052 (cond->> gen pred (such-that pred))))
10631063 min precludes -Infinity, and supplying a max precludes +Infinity."
10641064 [{:keys [infinite? NaN? min max]
10651065 :or {infinite? true, NaN? true}}]
1066 (let [frequency-arg (cond-> [[95 (double-finite min max)]]
1067
1068 (if (nil? min)
1069 (or (nil? max) (<= 0.0 max))
1070 (if (nil? max)
1071 (<= min 0.0)
1072 (<= min 0.0 max)))
1073 (conj
1074 ;; Add zeros here as a special case, since
1075 ;; the `finite` code considers zeros rather
1076 ;; complex (as they have a -1023 exponent)
1077 ;;
1078 ;; I think most uses can't distinguish 0.0
1079 ;; from -0.0, but seems worth throwing both
1080 ;; in just in case.
1081 [1 (return 0.0)]
1082 [1 (return -0.0)])
1083
1084 (and infinite? (nil? max))
1085 (conj [1 (return POS_INFINITY)])
1086
1087 (and infinite? (nil? min))
1088 (conj [1 (return NEG_INFINITY)])
1089
1090 NaN? (conj [1 (return NAN)]))]
1066 (core/let [frequency-arg (cond-> [[95 (double-finite min max)]]
1067
1068 (if (nil? min)
1069 (or (nil? max) (<= 0.0 max))
1070 (if (nil? max)
1071 (<= min 0.0)
1072 (<= min 0.0 max)))
1073 (conj
1074 ;; Add zeros here as a special case, since
1075 ;; the `finite` code considers zeros rather
1076 ;; complex (as they have a -1023 exponent)
1077 ;;
1078 ;; I think most uses can't distinguish 0.0
1079 ;; from -0.0, but seems worth throwing both
1080 ;; in just in case.
1081 [1 (return 0.0)]
1082 [1 (return -0.0)])
1083
1084 (and infinite? (nil? max))
1085 (conj [1 (return POS_INFINITY)])
1086
1087 (and infinite? (nil? min))
1088 (conj [1 (return NEG_INFINITY)])
1089
1090 NaN? (conj [1 (return NAN)]))]
10911091 (if (= 1 (count frequency-arg))
10921092 (-> frequency-arg first second)
10931093 (frequency frequency-arg))))
12561256 ;; seems to be 10x faster
12571257 (make-gen
12581258 (fn [rng _size]
1259 (let [[r1 r2] (random/split rng)
1260 x1 (-> (random/rand-long r1)
1261 (bit-and -45057)
1262 (bit-or 0x4000))
1263 x2 (-> (random/rand-long r2)
1264 (bit-or -9223372036854775808)
1265 (bit-and -4611686018427387905))]
1259 (core/let [[r1 r2] (random/split rng)
1260 x1 (-> (random/rand-long r1)
1261 (bit-and -45057)
1262 (bit-or 0x4000))
1263 x2 (-> (random/rand-long r2)
1264 (bit-or -9223372036854775808)
1265 (bit-and -4611686018427387905))]
12661266 (rose/make-rose
12671267 (java.util.UUID. x1 x2)
12681268 []))))
12721272 ;; generating 31 numbers
12731273 (fmap (fn [nibbles]
12741274 (letfn [(hex [idx] (.toString (nibbles idx) 16))]
1275 (let [rhex (-> (nibbles 15) (bit-and 3) (+ 8) (.toString 16))]
1275 (core/let [rhex (-> (nibbles 15) (bit-and 3) (+ 8) (.toString 16))]
12761276 (core/uuid (str (hex 0) (hex 1) (hex 2) (hex 3)
12771277 (hex 4) (hex 5) (hex 6) (hex 7) "-"
12781278 (hex 8) (hex 9) (hex 10) (hex 11) "-"
13291329 "Second arg to recursive-gen must be a generator")
13301330 (sized (fn [size]
13311331 (bind (choose 1 5)
1332 (fn [height] (let [children-size (Math/pow size (/ 1 height))]
1332 (fn [height] (core/let [children-size (Math/pow size (/ 1 height))]
13331333 (recursive-helper container-gen-fn scalar-gen size
13341334 children-size height)))))))
13351335
13411341 "Like any, but avoids characters that the shell will interpret as actions,
13421342 like 7 and 14 (bell and alternate character set command)"
13431343 (recursive-gen container-type simple-type-printable))
1344
1345
1346 ;; Macros
1347 ;; ---------------------------------------------------------------------------
1348
1349 (defmacro let
1350 "Macro for building generators using values from other generators.
1351 Uses a binding vector with the same syntax as clojure.core/let,
1352 where the right-hand side of the binding pairs are generators, and
1353 the left-hand side are names (or destructuring forms) for generated
1354 values.
1355
1356 Subsequent generator expressions can refer to the previously bound
1357 values, in the same way as clojure.core/let.
1358
1359 The body of the let can be either a value or a generator, and does
1360 the expected thing in either case. In this way let provides the
1361 functionality of both `bind` and `fmap`.
1362
1363 Examples:
1364
1365 (gen/let [strs (gen/not-empty (gen/list gen/string))
1366 s (gen/elements strs)]
1367 {:some-strings strs
1368 :one-of-those-strings s})
1369
1370 ;; generates collections of \"users\" that have integer IDs
1371 ;; from 0...N-1, but are in a random order
1372 (gen/let [users (gen/list (gen/hash-map :name gen/string-ascii
1373 :age gen/nat))]
1374 (->> users
1375 (map #(assoc %2 :id %1) (range))
1376 (gen/shuffle)))"
1377 [bindings & body]
1378 (assert (vector? bindings)
1379 "First arg to gen/let must be a vector of bindings.")
1380 (assert (even? (count bindings))
1381 "gen/let requires an even number of forms in binding vector")
1382 (if (empty? bindings)
1383 `(core/let [val# (do ~@body)]
1384 (if (generator? val#)
1385 val#
1386 (return val#)))
1387 (core/let [[binding gen & more] bindings]
1388 `(bind ~gen (fn [~binding] (let [~@more] ~@body))))))
+19
-0
src/test/clojure/clojure/test/check/test.cljc less more
881881 (prop/for-all [a gen/int]
882882 (integer? a)))
883883
884 ;; let macro
885 ;; ---------------------------------------------------------------------------
886
887 (defspec let-as-fmap-spec 20
888 (prop/for-all [s (gen/let [n gen/nat]
889 (str n))]
890 (re-matches #"\d+" s)))
891
892 (defspec let-as-bind-spec 20
893 (prop/for-all [[xs x] (gen/let [xs (gen/not-empty (gen/vector gen/nat))]
894 (gen/tuple (gen/return xs) (gen/elements xs)))]
895 (some #{x} xs)))
896
897 (defspec let-with-multiple-clauses-spec 20
898 (prop/for-all [[xs x] (gen/let [xs (gen/not-empty (gen/vector gen/nat))
899 x (gen/elements xs)]
900 [xs x])]
901 (some #{x} xs)))
902
884903 ;; TCHECK-77 Regression
885904 ;; ---------------------------------------------------------------------------
886905