Mercurial > lasercutter
comparison src/clojure/test_clojure/control.clj @ 10:ef7dbbd6452c
added clojure source goodness
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Sat, 21 Aug 2010 06:25:44 -0400 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
9:35cf337adfcf | 10:ef7dbbd6452c |
---|---|
1 ; Copyright (c) Rich Hickey. 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 ; Author: Frantisek Sodomka, Mike Hinchey, Stuart Halloway | |
10 | |
11 ;; | |
12 ;; Test "flow control" constructs. | |
13 ;; | |
14 | |
15 (ns clojure.test-clojure.control | |
16 (:use clojure.test | |
17 [clojure.test-clojure.helpers :only (exception)])) | |
18 | |
19 ;; *** Helper functions *** | |
20 | |
21 (defn maintains-identity [f] | |
22 (are [x] (= (f x) x) | |
23 nil | |
24 false true | |
25 0 42 | |
26 0.0 3.14 | |
27 2/3 | |
28 0M 1M | |
29 \c | |
30 "" "abc" | |
31 'sym | |
32 :kw | |
33 () '(1 2) | |
34 [] [1 2] | |
35 {} {:a 1 :b 2} | |
36 #{} #{1 2} )) | |
37 | |
38 | |
39 ; http://clojure.org/special_forms | |
40 ; http://clojure.org/macros | |
41 | |
42 (deftest test-do | |
43 (are [x y] (= x y) | |
44 ; no params => nil | |
45 (do) nil | |
46 | |
47 ; return last | |
48 (do 1) 1 | |
49 (do 1 2) 2 | |
50 (do 1 2 3 4 5) 5 | |
51 | |
52 ; evaluate and return last | |
53 (let [a (atom 0)] | |
54 (do (reset! a (+ @a 1)) ; 1 | |
55 (reset! a (+ @a 1)) ; 2 | |
56 (reset! a (+ @a 1)) ; 3 | |
57 @a)) 3 ) | |
58 | |
59 ; identity (= (do x) x) | |
60 (maintains-identity (fn [_] (do _))) ) | |
61 | |
62 | |
63 ;; loop/recur | |
64 (deftest test-loop | |
65 (are [x y] (= x y) | |
66 1 (loop [] | |
67 1) | |
68 3 (loop [a 1] | |
69 (if (< a 3) | |
70 (recur (inc a)) | |
71 a)) | |
72 [2 4 6] (loop [a [] | |
73 b [1 2 3]] | |
74 (if (seq b) | |
75 (recur (conj a (* 2 (first b))) | |
76 (next b)) | |
77 a)) | |
78 [6 4 2] (loop [a () | |
79 b [1 2 3]] | |
80 (if (seq b) | |
81 (recur (conj a (* 2 (first b))) | |
82 (next b)) | |
83 a)) | |
84 ) | |
85 ) | |
86 | |
87 | |
88 ;; throw, try | |
89 | |
90 ; if: see logic.clj | |
91 | |
92 (deftest test-when | |
93 (are [x y] (= x y) | |
94 1 (when true 1) | |
95 nil (when true) | |
96 nil (when false) | |
97 nil (when false (exception)) | |
98 )) | |
99 | |
100 (deftest test-when-not | |
101 (are [x y] (= x y) | |
102 1 (when-not false 1) | |
103 nil (when-not true) | |
104 nil (when-not false) | |
105 nil (when-not true (exception)) | |
106 )) | |
107 | |
108 (deftest test-if-not | |
109 (are [x y] (= x y) | |
110 1 (if-not false 1) | |
111 1 (if-not false 1 (exception)) | |
112 nil (if-not true 1) | |
113 2 (if-not true 1 2) | |
114 nil (if-not true (exception)) | |
115 1 (if-not true (exception) 1) | |
116 )) | |
117 | |
118 (deftest test-when-let | |
119 (are [x y] (= x y) | |
120 1 (when-let [a 1] | |
121 a) | |
122 2 (when-let [[a b] '(1 2)] | |
123 b) | |
124 nil (when-let [a false] | |
125 (exception)) | |
126 )) | |
127 | |
128 (deftest test-if-let | |
129 (are [x y] (= x y) | |
130 1 (if-let [a 1] | |
131 a) | |
132 2 (if-let [[a b] '(1 2)] | |
133 b) | |
134 nil (if-let [a false] | |
135 (exception)) | |
136 1 (if-let [a false] | |
137 a 1) | |
138 1 (if-let [[a b] nil] | |
139 b 1) | |
140 1 (if-let [a false] | |
141 (exception) | |
142 1) | |
143 )) | |
144 | |
145 (deftest test-when-first | |
146 (are [x y] (= x y) | |
147 1 (when-first [a [1 2]] | |
148 a) | |
149 2 (when-first [[a b] '((1 2) 3)] | |
150 b) | |
151 nil (when-first [a nil] | |
152 (exception)) | |
153 )) | |
154 | |
155 | |
156 (deftest test-cond | |
157 (are [x y] (= x y) | |
158 (cond) nil | |
159 | |
160 (cond nil true) nil | |
161 (cond false true) nil | |
162 | |
163 (cond true 1 true (exception)) 1 | |
164 (cond nil 1 false 2 true 3 true 4) 3 | |
165 (cond nil 1 false 2 true 3 true (exception)) 3 ) | |
166 | |
167 ; false | |
168 (are [x] (= (cond x :a true :b) :b) | |
169 nil false ) | |
170 | |
171 ; true | |
172 (are [x] (= (cond x :a true :b) :a) | |
173 true | |
174 0 42 | |
175 0.0 3.14 | |
176 2/3 | |
177 0M 1M | |
178 \c | |
179 "" "abc" | |
180 'sym | |
181 :kw | |
182 () '(1 2) | |
183 [] [1 2] | |
184 {} {:a 1 :b 2} | |
185 #{} #{1 2} ) | |
186 | |
187 ; evaluation | |
188 (are [x y] (= x y) | |
189 (cond (> 3 2) (+ 1 2) true :result true (exception)) 3 | |
190 (cond (< 3 2) (+ 1 2) true :result true (exception)) :result ) | |
191 | |
192 ; identity (= (cond true x) x) | |
193 (maintains-identity (fn [_] (cond true _))) ) | |
194 | |
195 | |
196 (deftest test-condp | |
197 (are [x] (= :pass x) | |
198 (condp = 1 | |
199 1 :pass | |
200 2 :fail) | |
201 (condp = 1 | |
202 2 :fail | |
203 1 :pass) | |
204 (condp = 1 | |
205 2 :fail | |
206 :pass) | |
207 (condp = 1 | |
208 :pass) | |
209 (condp = 1 | |
210 2 :fail | |
211 ;; doc of condp says result-expr is returned | |
212 ;; shouldn't it say similar to cond: "evaluates and returns | |
213 ;; the value of the corresponding expr and doesn't evaluate any of the | |
214 ;; other tests or exprs." | |
215 (identity :pass)) | |
216 (condp + 1 | |
217 1 :>> #(if (= % 2) :pass :fail)) | |
218 (condp + 1 | |
219 1 :>> #(if (= % 3) :fail :pass)) | |
220 ) | |
221 (is (thrown? IllegalArgumentException | |
222 (condp = 1) | |
223 )) | |
224 (is (thrown? IllegalArgumentException | |
225 (condp = 1 | |
226 2 :fail) | |
227 )) | |
228 ) | |
229 | |
230 | |
231 ; [for, doseq (for.clj)] | |
232 | |
233 (deftest test-dotimes | |
234 ;; dotimes always returns nil | |
235 (is (= nil (dotimes [n 1] n))) | |
236 ;; test using an atom since dotimes is for modifying | |
237 ;; test executes n times | |
238 (is (= 3 | |
239 (let [a (atom 0)] | |
240 (dotimes [n 3] | |
241 (swap! a inc)) | |
242 @a) | |
243 )) | |
244 ;; test all values of n | |
245 (is (= [0 1 2] | |
246 (let [a (atom [])] | |
247 (dotimes [n 3] | |
248 (swap! a conj n)) | |
249 @a))) | |
250 (is (= [] | |
251 (let [a (atom [])] | |
252 (dotimes [n 0] | |
253 (swap! a conj n)) | |
254 @a))) | |
255 ) | |
256 | |
257 (deftest test-while | |
258 (is (= nil (while nil (throw (Exception. "never"))))) | |
259 (is (= [0 nil] | |
260 ;; a will dec to 0 | |
261 ;; while always returns nil | |
262 (let [a (atom 3) | |
263 w (while (pos? @a) | |
264 (swap! a dec))] | |
265 [@a w]))) | |
266 (is (thrown? Exception (while true (throw (Exception. "expected to throw"))))) | |
267 ) | |
268 | |
269 ; locking, monitor-enter, monitor-exit | |
270 | |
271 ; case | |
272 (deftest test-case | |
273 (testing "can match many kinds of things" | |
274 (let [two 2 | |
275 test-fn | |
276 #(case % | |
277 1 :number | |
278 "foo" :string | |
279 \a :char | |
280 pow :symbol | |
281 :zap :keyword | |
282 (2 \b "bar") :one-of-many | |
283 [1 2] :sequential-thing | |
284 {:a 2} :map | |
285 {:r 2 :d 2} :droid | |
286 #{2 3 4 5} :set | |
287 [1 [[[2]]]] :deeply-nested | |
288 :default)] | |
289 (are [result input] (= result (test-fn input)) | |
290 :number 1 | |
291 :string "foo" | |
292 :char \a | |
293 :keyword :zap | |
294 :symbol 'pow | |
295 :one-of-many 2 | |
296 :one-of-many \b | |
297 :one-of-many "bar" | |
298 :sequential-thing [1 2] | |
299 :sequential-thing (list 1 2) | |
300 :sequential-thing [1 two] | |
301 :map {:a 2} | |
302 :map {:a two} | |
303 :set #{2 3 4 5} | |
304 :set #{two 3 4 5} | |
305 :default #{2 3 4 5 6} | |
306 :droid {:r 2 :d 2} | |
307 :deeply-nested [1 [[[two]]]] | |
308 :default :anything-not-appearing-above))) | |
309 (testing "throws IllegalArgumentException if no match" | |
310 (is (thrown-with-msg? | |
311 IllegalArgumentException #"No matching clause: 2" | |
312 (case 2 1 :ok)))) | |
313 (testing "sorting doesn't matter" | |
314 (let [test-fn | |
315 #(case % | |
316 {:b 2 :a 1} :map | |
317 #{3 2 1} :set | |
318 :default)] | |
319 (are [result input] (= result (test-fn input)) | |
320 :map {:a 1 :b 2} | |
321 :map (sorted-map :a 1 :b 2) | |
322 :set #{3 2 1} | |
323 :set (sorted-set 2 1 3)))) | |
324 (testing "test constants are *not* evaluated" | |
325 (let [test-fn | |
326 ;; never write code like this... | |
327 #(case % | |
328 (throw (RuntimeException. "boom")) :piece-of-throw-expr | |
329 :no-match)] | |
330 (are [result input] (= result (test-fn input)) | |
331 :piece-of-throw-expr 'throw | |
332 :piece-of-throw-expr '[RuntimeException. "boom"] | |
333 :no-match nil)))) |