Codebase list test-check-clojure / 4e28ce0
Add generators for distinct collections. This wasn't easy, as it had to be done at a low level instead of simply with pure combinators, because the ideal way to handle duplicate elements (in a way that interacts with collection sizes and shrinking well) is at a low level, using the same kind of "timeout" as such-that. Wrote a generic (private) generator called coll-distinct-by, and then implemented vector-distinct, list-distinct, set, and sorted-set using coll-distinct-by. Added similar sizing options to map, by reimplementing it with coll-distinct-by. Added tests for distinctness and size both for generated values and during shrinking. Also had to complicate a little bit by shuffling the generated collections to prevent them from biasing towards having smaller values at the beginning (e.g., without this (gen/vector-distinct gen/nat {:num-elements 3}) would only generate [0 1 2] with size=0 even though we'd like all orderings to be equally likely). Gary Fredericks 8 years ago
2 changed file(s) with 336 addition(s) and 8 deletion(s). Raw diff Collapse all Expand all
+222
-8
src/main/clojure/clojure/test/check/generators.cljc less more
99 (ns clojure.test.check.generators
1010 (:refer-clojure :exclude [int vector list hash-map map keyword
1111 char boolean byte bytes sequence
12 shuffle not-empty symbol namespace])
12 shuffle not-empty symbol namespace
13 set sorted-set])
1314 (:require [#?(:clj clojure.core :cljs cljs.core) :as core]
1415 [clojure.test.check.random :as random]
1516 [clojure.test.check.rose-tree :as rose]
504505 "Generates byte-arrays."
505506 (fmap core/byte-array (vector byte))))
506507
507 (defn map
508 "Create a generator that generates maps, with keys chosen from
509 `key-gen` and values chosen from `val-gen`."
510 [key-gen val-gen]
511 (let [input (vector (tuple key-gen val-gen))]
512 (fmap #(into {} %) input)))
513
514508 (defn hash-map
515509 "Like clojure.core/hash-map, except the values are generators.
516510 Returns a generator that makes maps with the supplied keys and
528522 "Value args to hash-map must be generators")
529523 (fmap #(zipmap ks %)
530524 (apply tuple vs))))
525
526 ;; Collections of distinct elements
527 ;; (has to be done in a low-level way (instead of with combinators)
528 ;; and is subject to the same kind of failure as such-that)
529 ;; ---------------------------------------------------------------------------
530
531 (defn ^:private transient-set-contains?
532 [s k]
533 #? (:clj
534 (.contains ^clojure.lang.ITransientSet s k)
535 :cljs
536 (some? (-lookup s k))))
537
538 (defn ^:private coll-distinct-by*
539 "Returns a rose tree."
540 [empty-coll key-fn shuffle-fn gen rng size num-elements max-tries]
541 {:pre [gen (:gen gen)]}
542 (loop [rose-trees (transient [])
543 s (transient #{})
544 rng rng
545 size size
546 tries 0]
547 (cond (= max-tries tries)
548 (throw (ex-info "Couldn't generate enough distinct elements!"
549 {:gen gen, :max-tries max-tries}))
550
551 (= (count rose-trees) num-elements)
552 (->> (persistent! rose-trees)
553 ;; we shuffle the rose trees so that we aren't biased
554 ;; toward generating "smaller" elements earlier in the
555 ;; collection (only applies to ordered collections)
556 ;;
557 ;; shuffling the rose trees is more efficient than
558 ;; (bind ... shuffle) because we only perform the
559 ;; shuffling once and we have no need to shrink the
560 ;; shufling.
561 (shuffle-fn rng)
562 (rose/shrink #(into empty-coll %&)))
563
564 :else
565 (let [[rng1 rng2] (random/split rng)
566 rose (call-gen gen rng1 size)
567 root (rose/root rose)
568 k (key-fn root)]
569 (if (transient-set-contains? s k)
570 (recur rose-trees s rng2 (inc size) (inc tries))
571 (recur (conj! rose-trees rose)
572 (conj! s k)
573 rng2
574 size
575 0))))))
576
577 (defn ^:private distinct-by?
578 "Like clojure.core/distinct? but takes a collection instead of varargs,
579 and returns true for empty collections."
580 [f coll]
581 (or (empty? coll)
582 (apply distinct? (core/map f coll))))
583
584 (defn ^:private the-shuffle-fn
585 "Returns a shuffled version of coll according to the rng.
586
587 Note that this is not a generator, it is just a utility function."
588 [rng coll]
589 (let [empty-coll (empty coll)
590 v (vec coll)
591 card (count coll)
592 dec-card (dec card)]
593 (into empty-coll
594 (first
595 (reduce (fn [[v rng] idx]
596 (let [[rng1 rng2] (random/split rng)
597 swap-idx (rand-range rng1 idx dec-card)]
598 [(swap v [idx swap-idx]) rng2]))
599 [v rng]
600 (range card))))))
601
602 (defn ^:private coll-distinct-by
603 [empty-coll key-fn allows-dupes? ordered? gen
604 {:keys [num-elements min-elements max-elements max-tries] :or {max-tries 10}}]
605 (let [shuffle-fn (if ordered?
606 the-shuffle-fn
607 (fn [_rng coll] coll))]
608 (if num-elements
609 (let [size-pred #(= num-elements (count %))]
610 (assert (and (nil? min-elements) (nil? max-elements)))
611 (make-gen
612 (fn [rng gen-size]
613 (rose/filter
614 (if allows-dupes?
615 ;; is there a smarter way to do the shrinking than checking
616 ;; the distinctness of the entire collection at each
617 ;; step?
618 (every-pred size-pred #(distinct-by? key-fn %))
619 size-pred)
620 (coll-distinct-by* empty-coll key-fn shuffle-fn gen
621 rng gen-size num-elements max-tries)))))
622 (let [min-elements (or min-elements 0)
623 size-pred (if max-elements
624 #(<= min-elements (count %) max-elements)
625 #(<= min-elements (count %)))]
626 (gen-bind
627 (if max-elements
628 (choose min-elements max-elements)
629 (sized #(choose min-elements (+ min-elements %))))
630 (fn [num-elements-rose]
631 (let [num-elements (rose/root num-elements-rose)]
632 (make-gen
633 (fn [rng gen-size]
634 (rose/filter
635 (if allows-dupes?
636 ;; same comment as above
637 (every-pred size-pred #(distinct-by? key-fn %))
638 size-pred)
639 (coll-distinct-by* empty-coll key-fn shuffle-fn gen
640 rng gen-size num-elements max-tries)))))))))))
641
642
643 ;; I tried to reduce the duplication in these docstrings with a macro,
644 ;; but couldn't make it work in cljs.
645
646 (defn vector-distinct
647 "Generates a vector of elements from the given generator, with the
648 guarantee that the elements will be distinct.
649
650 If the generator cannot or is unlikely to produce enough distinct
651 elements, this generator will fail in the same way as such-that.
652
653 Available options:
654
655 :num-elements the fixed size of generated vectors
656 :min-elements the min size of generated vectors
657 :max-elements the max size of generated vectors
658 :max-tries the number of times the generator will be tried before
659 failing when it does not produce distinct elements
660 (default 10)"
661 ([gen] (vector-distinct gen {}))
662 ([gen opts]
663 (assert (generator? gen) "First arg to vector-distinct must be a generator!")
664 (coll-distinct-by [] identity true true gen opts)))
665
666 (defn list-distinct
667 "Generates a list of elements from the given generator, with the
668 guarantee that the elements will be distinct.
669
670 If the generator cannot or is unlikely to produce enough distinct
671 elements, this generator will fail in the same way as such-that.
672
673 Available options:
674
675 :num-elements the fixed size of generated vectors
676 :min-elements the min size of generated vectors
677 :max-elements the max size of generated vectors
678 :max-tries the number of times the generator will be tried before
679 failing when it does not produce distinct elements
680 (default 10)"
681 ([gen] (list-distinct gen {}))
682 ([gen opts]
683 (assert (generator? gen) "First arg to list-distinct must be a generator!")
684 (coll-distinct-by () identity true true gen opts)))
685
686 (defn set
687 "Generates a set of elements from the given generator.
688
689 If the generator cannot or is unlikely to produce enough distinct
690 elements, this generator will fail in the same way as such-that.
691
692 Available options:
693
694 :num-elements the fixed size of generated vectors
695 :min-elements the min size of generated vectors
696 :max-elements the max size of generated vectors
697 :max-tries the number of times the generator will be tried before
698 failing when it does not produce distinct elements
699 (default 10)"
700 ([gen] (set gen {}))
701 ([gen opts]
702 (assert (generator? gen) "First arg to set must be a generator!")
703 (coll-distinct-by #{} identity false false gen opts)))
704
705 (defn sorted-set
706 "Generates a sorted set of elements from the given generator.
707
708 If the generator cannot or is unlikely to produce enough distinct
709 elements, this generator will fail in the same way as such-that.
710
711 Available options:
712
713 :num-elements the fixed size of generated vectors
714 :min-elements the min size of generated vectors
715 :max-elements the max size of generated vectors
716 :max-tries the number of times the generator will be tried before
717 failing when it does not produce distinct elements
718 (default 10)"
719 ([gen] (sorted-set gen {}))
720 ([gen opts]
721 (assert (generator? gen) "First arg to sorted-set must be a generator!")
722 (coll-distinct-by (core/sorted-set) identity false false gen opts)))
723
724 (defn map
725 "Create a generator that generates maps, with keys chosen from
726 `key-gen` and values chosen from `val-gen`.
727
728 If the key generator cannot or is unlikely to produce enough distinct
729 elements, this generator will fail in the same way as such-that.
730
731 Available options:
732
733 :num-elements the fixed size of generated vectors
734 :min-elements the min size of generated vectors
735 :max-elements the max size of generated vectors
736 :max-tries the number of times the generator will be tried before
737 failing when it does not produce distinct elements
738 (default 10)"
739 ([key-gen val-gen] (map key-gen val-gen {}))
740 ([key-gen val-gen opts]
741 (coll-distinct-by {} first false false (tuple key-gen val-gen) opts)))
742
743 ;; Characters & Strings
744 ;; ---------------------------------------------------------------------------
531745
532746 (def char
533747 "Generates character from 0-255."
+114
-0
src/test/clojure/clojure/test/check/test.cljc less more
1919 #?(:clj [clojure.edn :as edn]
2020 :cljs [cljs.reader :as edn])))
2121
22 (def gen-seed
23 (let [gen-int (gen/choose 0 0x100000000)]
24 (gen/fmap (fn [[s1 s2]]
25 (bit-or s1 (bit-shift-left s2 32)))
26 (gen/tuple gen-int gen-int))))
27
2228 (deftest generators-are-generators
2329 (testing "generator? returns true when called with a generator"
2430 (is (gen/generator? gen/int))
289295 (testing "list" (t (gen/list gen/int) list?))
290296 (testing "map" (t (gen/map gen/int gen/int) map?))
291297 ))
298
299 ;; Distinct collections
300 ;; --------------------------------------------------------------------------
301
302 (def gen-distinct-generator
303 (gen/elements [gen/list-distinct gen/vector-distinct
304 gen/set gen/sorted-set]))
305
306 (def gen-size-bounds-and-pred
307 "Generates [pred size-opts], where size-opts is a map to pass to
308 distinct generators, and pred is a predicate on the size of a
309 collection, to check that it matches the options."
310 (gen/one-of
311 [(gen/return [(constantly true) {}])
312 (gen/fmap (fn [num-elements]
313 [#{num-elements} {:num-elements num-elements}])
314 gen/nat)
315 (gen/fmap (fn [min-elements]
316 [#(<= min-elements %) {:min-elements min-elements}])
317 gen/nat)
318 (gen/fmap (fn [max-elements]
319 [#(<= % max-elements) {:max-elements max-elements}])
320 gen/nat)
321 (gen/fmap (fn [bounds]
322 (let [[min-elements max-elements] (sort bounds)]
323 [#(<= min-elements % max-elements)
324 {:min-elements min-elements
325 :max-elements max-elements}]))
326 (gen/tuple gen/nat gen/nat))]))
327
328 (defspec map-honors-size-opts
329 (prop/for-all [[the-map size-pred _]
330 (gen/bind gen-size-bounds-and-pred
331 (fn [[pred size-opts]]
332 (gen/fmap #(vector % pred size-opts)
333 (gen/map gen/string gen/nat size-opts))))]
334 (size-pred (count the-map))))
335
336 (defspec distinct-collections-honor-size-opts
337 (prop/for-all [[the-coll size-pred _]
338 (gen/bind (gen/tuple gen-size-bounds-and-pred
339 gen-distinct-generator)
340 (fn [[[pred size-opts] coll-gen]]
341 (gen/fmap #(vector % pred size-opts)
342 (coll-gen gen/string size-opts))))]
343 (size-pred (count the-coll))))
344
345 (defspec distinct-collections-are-distinct
346 (prop/for-all [the-coll
347 (gen/bind (gen/tuple gen-size-bounds-and-pred
348 gen-distinct-generator)
349 (fn [[[_ size-opts] coll-gen]]
350 (coll-gen gen/string size-opts)))]
351 (or (empty? the-coll)
352 (apply distinct? the-coll))))
353
354 (deftest distinct-generators-throw-when-necessary
355 ;; I tried using `are` here but it breaks in cljs
356 (doseq [g [gen/vector-distinct
357 gen/list-distinct
358 gen/set
359 gen/sorted-set]]
360 (is (thrown? #?(:clj Exception :cljs js/Error)
361 (first (gen/sample
362 (g gen/boolean {:min-elements 5}))))))
363 (is (thrown? #?(:clj Exception :cljs js/Error)
364 (first (gen/sample
365 (gen/map gen/boolean gen/nat {:min-elements 5}))))))
366
367 (defspec shrinking-respects-distinctness-and-sizing 20
368 (prop/for-all [g gen-distinct-generator
369 seed gen-seed
370 size (gen/choose 1 20)
371 [pred opts] gen-size-bounds-and-pred]
372 (let [rose-tree (gen/call-gen (g (gen/choose 0 1000) opts)
373 (random/make-random seed) size)
374 ;; inevitably some of these will be way too long to actually
375 ;; test, so this is the easiest thing to do :/
376 vals (take 1000 (rose/seq rose-tree))]
377 (every? (fn [coll]
378 (and (or (empty? coll)
379 (apply distinct? coll))
380 (pred (count coll))))
381 vals))))
382
383 (defspec distinct-generators-can-shrink-in-size 20
384 (prop/for-all [g gen-distinct-generator
385 seed gen-seed
386 size (gen/choose 1 20)]
387 (let [rose-tree (gen/call-gen (g (gen/choose 0 1000))
388 (random/make-random seed) size)
389 a-shrink (->> rose-tree
390 (iterate #(first (rose/children %)))
391 (take-while identity)
392 (map rose/root))]
393 (and (apply > (map #(reduce + %) a-shrink))
394 (empty? (last a-shrink))))))
395
396 (defspec distinct-collections-are-not-biased-in-their-ordering 5
397 (prop/for-all [g (gen/elements [gen/vector-distinct gen/list-distinct])
398 seed gen-seed]
399 (let [rng (random/make-random seed)]
400 (every?
401 (->> (gen/lazy-random-states rng)
402 (take 1000)
403 (map #(rose/root (gen/call-gen (g gen/nat {:num-elements 3, :max-tries 100}) % 0)))
404 (set))
405 [[0 1 2] [0 2 1] [1 0 2] [1 2 0] [2 0 1] [2 1 0]]))))
292406
293407 ;; Generating proper matrices
294408 ;; ---------------------------------------------------------------------------