Codebase list test-check-clojure / ed0e180
clojure_test_check.{[clj cljs] -> cljc} Nicolas Berger authored 8 years ago Gary Fredericks committed 8 years ago
5 changed file(s) with 145 addition(s) and 255 deletion(s). Raw diff Collapse all Expand all
+3
-8
src/main/clojure/clojure/test/check/clojure_test.cljc less more
88
99 (ns clojure.test.check.clojure-test
1010 (:require #?(:clj [clojure.test :as ct]
11 :cljs [cljs.test :as ct :include-macros true])))
12
13 (defn exception-like? [v]
14 (instance? #?(:clj Throwable :cljs js/Error) v))
11 :cljs [cljs.test :as ct :include-macros true])
12 [clojure.test.check.impl :refer [get-current-time-millis
13 exception-like?]]))
1514
1615 (defn assert-check
1716 [{:keys [result] :as m}]
9291
9392 (def ^:private last-trial-report (atom 0))
9493
95 (defn get-current-time-millis []
96 #?(:clj (System/currentTimeMillis)
97 :cljs (.valueOf (js/Date.))))
98
9994 (let [begin-test-var-method (get-method ct/report #?(:clj :begin-test-var
10095 :cljs [::ct/default :begin-test-var]))]
10196 (defmethod ct/report #?(:clj :begin-test-var
+17
-0
src/main/clojure/clojure/test/check/impl.cljc less more
0 ; Copyright (c) Rich Hickey, Reid Draper, and contributors.
1 ; All rights reserved.
2 ; The use and distribution terms for this software are covered by the
3 ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
4 ; which can be found in the file epl-v10.html at the root of this distribution.
5 ; By using this software in any fashion, you are agreeing to be bound by
6 ; the terms of this license.
7 ; You must not remove this notice, or any other, from this software.
8
9 (ns clojure.test.check.impl)
10
11 (defn exception-like? [v]
12 (instance? #?(:clj Throwable :cljs js/Error) v))
13
14 (defn get-current-time-millis []
15 #?(:clj (System/currentTimeMillis)
16 :cljs (.valueOf (js/Date.))))
+0
-123
src/main/clojure/clojure/test/check.clj less more
0 ; Copyright (c) Rich Hickey, Reid Draper, and contributors.
1 ; All rights reserved.
2 ; The use and distribution terms for this software are covered by the
3 ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
4 ; which can be found in the file epl-v10.html at the root of this distribution.
5 ; By using this software in any fashion, you are agreeing to be bound by
6 ; the terms of this license.
7 ; You must not remove this notice, or any other, from this software.
8
9 (ns clojure.test.check
10 (:require [clojure.test.check.generators :as gen]
11 [clojure.test.check.clojure-test :as ct]
12 [clojure.test.check.random :as random]
13 [clojure.test.check.rose-tree :as rose]))
14
15 (declare shrink-loop failure)
16
17 (defn- make-rng
18 [seed]
19 (if seed
20 [seed (random/make-random seed)]
21 (let [non-nil-seed (System/currentTimeMillis)]
22 [non-nil-seed (random/make-random non-nil-seed)])))
23
24 (defn- complete
25 [property num-trials seed]
26 (ct/report-trial property num-trials num-trials)
27 {:result true :num-tests num-trials :seed seed})
28
29 (defn- not-falsey-or-exception?
30 "True if the value is not falsy or an exception"
31 [value]
32 (and value (not (instance? Throwable value))))
33
34 (defn quick-check
35 "Tests `property` `num-tests` times.
36 Takes optional keys `:seed` and `:max-size`. The seed parameter
37 can be used to re-run previous tests, as the seed used is returned
38 after a test is run. The max-size can be used to control the 'size'
39 of generated values. The size will start at 0, and grow up to
40 max-size, as the number of tests increases. Generators will use
41 the size parameter to bound their growth. This prevents, for example,
42 generating a five-thousand element vector on the very first test.
43
44 Examples:
45
46 (def p (for-all [a gen/pos-int] (> (* a a) a)))
47 (quick-check 100 p)
48 "
49 [num-tests property & {:keys [seed max-size] :or {max-size 200}}]
50 (let [[created-seed rng] (make-rng seed)
51 size-seq (gen/make-size-range-seq max-size)]
52 (loop [so-far 0
53 size-seq size-seq
54 rstate rng]
55 (if (== so-far num-tests)
56 (complete property num-tests created-seed)
57 (let [[size & rest-size-seq] size-seq
58 [r1 r2] (random/split rstate)
59 result-map-rose (gen/call-gen property r1 size)
60 result-map (rose/root result-map-rose)
61 result (:result result-map)
62 args (:args result-map)]
63 (if (not-falsey-or-exception? result)
64 (do
65 (ct/report-trial property so-far num-tests)
66 (recur (inc so-far) rest-size-seq r2))
67 (failure property result-map-rose so-far size created-seed)))))))
68
69 (defn- smallest-shrink
70 [total-nodes-visited depth smallest]
71 {:total-nodes-visited total-nodes-visited
72 :depth depth
73 :result (:result smallest)
74 :smallest (:args smallest)})
75
76 (defn- shrink-loop
77 "Shrinking a value produces a sequence of smaller values of the same type.
78 Each of these values can then be shrunk. Think of this as a tree. We do a
79 modified depth-first search of the tree:
80
81 Do a non-exhaustive search for a deeper (than the root) failing example.
82 Additional rules added to depth-first search:
83 * If a node passes the property, you may continue searching at this depth,
84 but not backtrack
85 * If a node fails the property, search its children
86 The value returned is the left-most failing example at the depth where a
87 passing example was found."
88 [rose-tree]
89 (let [shrinks-this-depth (rose/children rose-tree)]
90 (loop [nodes shrinks-this-depth
91 current-smallest (rose/root rose-tree)
92 total-nodes-visited 0
93 depth 0]
94 (if (empty? nodes)
95 (smallest-shrink total-nodes-visited depth current-smallest)
96 (let [[head & tail] nodes
97 result (:result (rose/root head))]
98 (if (not-falsey-or-exception? result)
99 ;; this node passed the test, so now try testing its right-siblings
100 (recur tail current-smallest (inc total-nodes-visited) depth)
101 ;; this node failed the test, so check if it has children,
102 ;; if so, traverse down them. If not, save this as the best example
103 ;; seen now and then look at the right-siblings
104 ;; children
105 (if-let [children (seq (rose/children head))]
106 (recur children (rose/root head) (inc total-nodes-visited) (inc depth))
107 (recur tail (rose/root head) (inc total-nodes-visited) depth))))))))
108
109 (defn- failure
110 [property failing-rose-tree trial-number size seed]
111 (let [root (rose/root failing-rose-tree)
112 result (:result root)
113 failing-args (:args root)]
114
115 (ct/report-failure property result trial-number failing-args)
116
117 {:result result
118 :seed seed
119 :failing-size size
120 :num-tests (inc trial-number)
121 :fail (vec failing-args)
122 :shrunk (shrink-loop failing-rose-tree)}))
+125
-0
src/main/clojure/clojure/test/check.cljc less more
0 ; Copyright (c) Rich Hickey, Reid Draper, and contributors.
1 ; All rights reserved.
2 ; The use and distribution terms for this software are covered by the
3 ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
4 ; which can be found in the file epl-v10.html at the root of this distribution.
5 ; By using this software in any fashion, you are agreeing to be bound by
6 ; the terms of this license.
7 ; You must not remove this notice, or any other, from this software.
8
9 (ns clojure.test.check
10 (:require [clojure.test.check.generators :as gen]
11 [clojure.test.check.clojure-test :as ct]
12 [clojure.test.check.random :as random]
13 [clojure.test.check.rose-tree :as rose]
14 [clojure.test.check.impl :refer [get-current-time-millis
15 exception-like?]]))
16
17 (declare shrink-loop failure)
18
19 (defn- make-rng
20 [seed]
21 (if seed
22 [seed (random/make-random seed)]
23 (let [non-nil-seed (get-current-time-millis)]
24 [non-nil-seed (random/make-random non-nil-seed)])))
25
26 (defn- complete
27 [property num-trials seed]
28 (ct/report-trial property num-trials num-trials)
29 {:result true :num-tests num-trials :seed seed})
30
31 (defn- not-falsey-or-exception?
32 "True if the value is not falsy or an exception"
33 [value]
34 (and value (not (exception-like? value))))
35
36 (defn quick-check
37 "Tests `property` `num-tests` times.
38 Takes optional keys `:seed` and `:max-size`. The seed parameter
39 can be used to re-run previous tests, as the seed used is returned
40 after a test is run. The max-size can be used to control the 'size'
41 of generated values. The size will start at 0, and grow up to
42 max-size, as the number of tests increases. Generators will use
43 the size parameter to bound their growth. This prevents, for example,
44 generating a five-thousand element vector on the very first test.
45
46 Examples:
47
48 (def p (for-all [a gen/pos-int] (> (* a a) a)))
49 (quick-check 100 p)
50 "
51 [num-tests property & {:keys [seed max-size] :or {max-size 200}}]
52 (let [[created-seed rng] (make-rng seed)
53 size-seq (gen/make-size-range-seq max-size)]
54 (loop [so-far 0
55 size-seq size-seq
56 rstate rng]
57 (if (== so-far num-tests)
58 (complete property num-tests created-seed)
59 (let [[size & rest-size-seq] size-seq
60 [r1 r2] (random/split rstate)
61 result-map-rose (gen/call-gen property r1 size)
62 result-map (rose/root result-map-rose)
63 result (:result result-map)
64 args (:args result-map)]
65 (if (not-falsey-or-exception? result)
66 (do
67 (ct/report-trial property so-far num-tests)
68 (recur (inc so-far) rest-size-seq r2))
69 (failure property result-map-rose so-far size created-seed)))))))
70
71 (defn- smallest-shrink
72 [total-nodes-visited depth smallest]
73 {:total-nodes-visited total-nodes-visited
74 :depth depth
75 :result (:result smallest)
76 :smallest (:args smallest)})
77
78 (defn- shrink-loop
79 "Shrinking a value produces a sequence of smaller values of the same type.
80 Each of these values can then be shrunk. Think of this as a tree. We do a
81 modified depth-first search of the tree:
82
83 Do a non-exhaustive search for a deeper (than the root) failing example.
84 Additional rules added to depth-first search:
85 * If a node passes the property, you may continue searching at this depth,
86 but not backtrack
87 * If a node fails the property, search its children
88 The value returned is the left-most failing example at the depth where a
89 passing example was found."
90 [rose-tree]
91 (let [shrinks-this-depth (rose/children rose-tree)]
92 (loop [nodes shrinks-this-depth
93 current-smallest (rose/root rose-tree)
94 total-nodes-visited 0
95 depth 0]
96 (if (empty? nodes)
97 (smallest-shrink total-nodes-visited depth current-smallest)
98 (let [[head & tail] nodes
99 result (:result (rose/root head))]
100 (if (not-falsey-or-exception? result)
101 ;; this node passed the test, so now try testing its right-siblings
102 (recur tail current-smallest (inc total-nodes-visited) depth)
103 ;; this node failed the test, so check if it has children,
104 ;; if so, traverse down them. If not, save this as the best example
105 ;; seen now and then look at the right-siblings
106 ;; children
107 (if-let [children (seq (rose/children head))]
108 (recur children (rose/root head) (inc total-nodes-visited) (inc depth))
109 (recur tail (rose/root head) (inc total-nodes-visited) depth))))))))
110
111 (defn- failure
112 [property failing-rose-tree trial-number size seed]
113 (let [root (rose/root failing-rose-tree)
114 result (:result root)
115 failing-args (:args root)]
116
117 (ct/report-failure property result trial-number failing-args)
118
119 {:result result
120 :seed seed
121 :failing-size size
122 :num-tests (inc trial-number)
123 :fail (vec failing-args)
124 :shrunk (shrink-loop failing-rose-tree)}))
+0
-124
src/main/clojure/clojure/test/check.cljs less more
0 ; Copyright (c) Rich Hickey, Reid Draper, and contributors.
1 ; All rights reserved.
2 ; The use and distribution terms for this software are covered by the
3 ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
4 ; which can be found in the file epl-v10.html at the root of this distribution.
5 ; By using this software in any fashion, you are agreeing to be bound by
6 ; the terms of this license.
7 ; You must not remove this notice, or any other, from this software.
8
9 (ns clojure.test.check
10 (:require [clojure.test.check.generators :as gen]
11 [clojure.test.check.clojure-test :as ct]
12 [clojure.test.check.random :as random]
13 [clojure.test.check.rose-tree :as rose]))
14
15 (declare shrink-loop failure)
16
17 (defn- make-rng
18 [seed]
19 (if seed
20 [seed (random/make-random seed)]
21 (let [non-nil-seed (.valueOf (js/Date.))]
22 [non-nil-seed (random/make-random non-nil-seed)])))
23
24 (defn- complete
25 [property num-trials seed]
26 (ct/report-trial property num-trials num-trials)
27 {:result true :num-tests num-trials :seed seed})
28
29 (defn- not-falsey-or-exception?
30 "True if the value is not falsy or an exception"
31 [value]
32 (and value (not (instance? js/Error value))))
33
34 (defn quick-check
35 "Tests `property` `num-tests` times.
36 Takes optional keys `:seed` and `:max-size`. The seed parameter
37 can be used to re-run previous tests, as the seed used is returned
38 after a test is run. The max-size can be used to control the 'size'
39 of generated values. The size will start at 0, and grow up to
40 max-size, as the number of tests increases. Generators will use
41 the size parameter to bound their growth. This prevents, for example,
42 generating a five-thousand element vector on the very first test.
43
44 Examples:
45
46 (def p (for-all [a gen/pos-int] (> (* a a) a)))
47 (quick-check 100 p)
48 "
49 [num-tests property & {:keys [seed max-size] :or {max-size 200}}]
50 (let [[created-seed rng] (make-rng seed)
51 size-seq (gen/make-size-range-seq max-size)]
52 (loop [so-far 0
53 size-seq size-seq
54 rstate rng]
55 (if (== so-far num-tests)
56 (complete property num-tests created-seed)
57 (let [[size & rest-size-seq] size-seq
58 [r1 r2] (random/split rstate)
59 result-map-rose (gen/call-gen property r1 size)
60 result-map (rose/root result-map-rose)
61 result (:result result-map)
62 args (:args result-map)]
63 (if (not-falsey-or-exception? result)
64 (do
65 (ct/report-trial property so-far num-tests)
66 (recur (inc so-far) rest-size-seq r2))
67 (failure property result-map-rose so-far size created-seed)))))))
68
69 (defn- smallest-shrink
70 [total-nodes-visited depth smallest]
71 {:total-nodes-visited total-nodes-visited
72 :depth depth
73 :result (:result smallest)
74 :smallest (:args smallest)})
75
76 (defn- shrink-loop
77 "Shrinking a value produces a sequence of smaller values of the same type.
78 Each of these values can then be shrunk. Think of this as a tree. We do a
79 modified depth-first search of the tree:
80
81 Do a non-exhaustive search for a deeper (than the root) failing example.
82 Additional rules added to depth-first search:
83 * If a node passes the property, you may continue searching at this depth,
84 but not backtrack
85 * If a node fails the property, search its children
86 The value returned is the left-most failing example at the depth where a
87 passing example was found."
88 [rose-tree]
89 (let [shrinks-this-depth (rose/children rose-tree)]
90 (loop [nodes shrinks-this-depth
91 current-smallest (rose/root rose-tree)
92 total-nodes-visited 0
93 depth 0]
94 (if (empty? nodes)
95 (smallest-shrink total-nodes-visited depth current-smallest)
96 (let [[head & tail] nodes
97 result (:result (rose/root head))]
98 (if (not-falsey-or-exception? result)
99 ;; this node passed the test, so now try testing its right-siblings
100 (recur tail current-smallest (inc total-nodes-visited) depth)
101 ;; this node failed the test, so check if it has children,
102 ;; if so, traverse down them. If not, save this as the best example
103 ;; seen now and then look at the right-siblings
104 ;; children
105 (let [children (rose/children head)]
106 (if (empty? children)
107 (recur tail (rose/root head) (inc total-nodes-visited) depth)
108 (recur children (rose/root head) (inc total-nodes-visited) (inc depth))))))))))
109
110 (defn- failure
111 [property failing-rose-tree trial-number size seed]
112 (let [root (rose/root failing-rose-tree)
113 result (:result root)
114 failing-args (:args root)]
115
116 (ct/report-failure property result trial-number failing-args)
117
118 {:result result
119 :seed seed
120 :failing-size size
121 :num-tests (inc trial-number)
122 :fail (vec failing-args)
123 :shrunk (shrink-loop failing-rose-tree)}))