Mercurial > lasercutter

annotate src/clojure/test_clojure/control.clj @ 10:ef7dbbd6452c

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