1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/test_clojure/control.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,333 @@
     1.4 +;   Copyright (c) Rich Hickey. All rights reserved.
     1.5 +;   The use and distribution terms for this software are covered by the
     1.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
     1.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
     1.8 +;   By using this software in any fashion, you are agreeing to be bound by
     1.9 +;   the terms of this license.
    1.10 +;   You must not remove this notice, or any other, from this software.
    1.11 +
    1.12 +; Author: Frantisek Sodomka, Mike Hinchey, Stuart Halloway
    1.13 +
    1.14 +;;
    1.15 +;;  Test "flow control" constructs.
    1.16 +;;
    1.17 +
    1.18 +(ns clojure.test-clojure.control
    1.19 +  (:use clojure.test
    1.20 +        [clojure.test-clojure.helpers :only (exception)]))
    1.21 +
    1.22 +;; *** Helper functions ***
    1.23 +
    1.24 +(defn maintains-identity [f]
    1.25 +  (are [x] (= (f x) x)
    1.26 +      nil
    1.27 +      false true
    1.28 +      0 42
    1.29 +      0.0 3.14
    1.30 +      2/3
    1.31 +      0M 1M
    1.32 +      \c
    1.33 +      "" "abc"
    1.34 +      'sym
    1.35 +      :kw
    1.36 +      () '(1 2)
    1.37 +      [] [1 2]
    1.38 +      {} {:a 1 :b 2}
    1.39 +      #{} #{1 2} ))
    1.40 +
    1.41 +
    1.42 +; http://clojure.org/special_forms
    1.43 +; http://clojure.org/macros
    1.44 +
    1.45 +(deftest test-do
    1.46 +  (are [x y] (= x y)
    1.47 +      ; no params => nil
    1.48 +      (do) nil
    1.49 +      
    1.50 +      ; return last
    1.51 +      (do 1) 1
    1.52 +      (do 1 2) 2
    1.53 +      (do 1 2 3 4 5) 5
    1.54 +      
    1.55 +      ; evaluate and return last
    1.56 +      (let [a (atom 0)]
    1.57 +        (do (reset! a (+ @a 1))   ; 1
    1.58 +            (reset! a (+ @a 1))   ; 2
    1.59 +            (reset! a (+ @a 1))   ; 3
    1.60 +            @a))  3 )
    1.61 +
    1.62 +  ; identity (= (do x) x)
    1.63 +  (maintains-identity (fn [_] (do _))) )
    1.64 +
    1.65 +
    1.66 +;; loop/recur
    1.67 +(deftest test-loop
    1.68 +  (are [x y] (= x y)
    1.69 +       1 (loop []
    1.70 +           1)
    1.71 +       3 (loop [a 1]
    1.72 +           (if (< a 3)
    1.73 +             (recur (inc a))
    1.74 +             a))
    1.75 +       [2 4 6] (loop [a []
    1.76 +                      b [1 2 3]]
    1.77 +                 (if (seq b)
    1.78 +                   (recur (conj a (* 2 (first b)))
    1.79 +                          (next b))
    1.80 +                   a))
    1.81 +       [6 4 2] (loop [a ()
    1.82 +                      b [1 2 3]]
    1.83 +                 (if (seq b)
    1.84 +                   (recur (conj a (* 2 (first b)))
    1.85 +                          (next b))
    1.86 +                   a))
    1.87 +       )
    1.88 +  )
    1.89 +
    1.90 +
    1.91 +;; throw, try
    1.92 +
    1.93 +; if: see logic.clj
    1.94 +
    1.95 +(deftest test-when
    1.96 +  (are [x y] (= x y)
    1.97 +       1 (when true 1)
    1.98 +       nil (when true)
    1.99 +       nil (when false)
   1.100 +       nil (when false (exception))
   1.101 +       ))
   1.102 +
   1.103 +(deftest test-when-not
   1.104 +  (are [x y] (= x y)
   1.105 +       1 (when-not false 1)
   1.106 +       nil (when-not true)
   1.107 +       nil (when-not false)
   1.108 +       nil (when-not true (exception))
   1.109 +       ))
   1.110 +
   1.111 +(deftest test-if-not
   1.112 +  (are [x y] (= x y)
   1.113 +       1 (if-not false 1)
   1.114 +       1 (if-not false 1 (exception))
   1.115 +       nil (if-not true 1)
   1.116 +       2 (if-not true 1 2)
   1.117 +       nil (if-not true (exception))
   1.118 +       1 (if-not true (exception) 1)
   1.119 +       ))
   1.120 +
   1.121 +(deftest test-when-let
   1.122 +  (are [x y] (= x y)
   1.123 +       1 (when-let [a 1]
   1.124 +           a)
   1.125 +       2 (when-let [[a b] '(1 2)]
   1.126 +           b)
   1.127 +       nil (when-let [a false]
   1.128 +             (exception))
   1.129 +       ))
   1.130 +
   1.131 +(deftest test-if-let
   1.132 +  (are [x y] (= x y)
   1.133 +       1 (if-let [a 1]
   1.134 +           a)
   1.135 +       2 (if-let [[a b] '(1 2)]
   1.136 +           b)
   1.137 +       nil (if-let [a false]
   1.138 +             (exception))
   1.139 +       1 (if-let [a false]
   1.140 +           a 1)
   1.141 +       1 (if-let [[a b] nil]
   1.142 +             b 1)
   1.143 +       1 (if-let [a false]
   1.144 +           (exception)
   1.145 +           1)
   1.146 +       ))
   1.147 +
   1.148 +(deftest test-when-first
   1.149 +  (are [x y] (= x y)
   1.150 +       1 (when-first [a [1 2]]
   1.151 +           a)
   1.152 +       2 (when-first [[a b] '((1 2) 3)]
   1.153 +           b)
   1.154 +       nil (when-first [a nil]
   1.155 +             (exception))
   1.156 +       ))
   1.157 +
   1.158 +
   1.159 +(deftest test-cond
   1.160 +  (are [x y] (= x y)
   1.161 +      (cond) nil
   1.162 +
   1.163 +      (cond nil true) nil
   1.164 +      (cond false true) nil
   1.165 +      
   1.166 +      (cond true 1 true (exception)) 1
   1.167 +      (cond nil 1 false 2 true 3 true 4) 3
   1.168 +      (cond nil 1 false 2 true 3 true (exception)) 3 )
   1.169 +
   1.170 +  ; false
   1.171 +  (are [x]  (= (cond x :a true :b) :b)
   1.172 +      nil false )
   1.173 +
   1.174 +  ; true
   1.175 +  (are [x]  (= (cond x :a true :b) :a)
   1.176 +      true
   1.177 +      0 42
   1.178 +      0.0 3.14
   1.179 +      2/3
   1.180 +      0M 1M
   1.181 +      \c
   1.182 +      "" "abc"
   1.183 +      'sym
   1.184 +      :kw
   1.185 +      () '(1 2)
   1.186 +      [] [1 2]
   1.187 +      {} {:a 1 :b 2}
   1.188 +      #{} #{1 2} )
   1.189 +
   1.190 +  ; evaluation
   1.191 +  (are [x y] (= x y)
   1.192 +      (cond (> 3 2) (+ 1 2) true :result true (exception)) 3
   1.193 +      (cond (< 3 2) (+ 1 2) true :result true (exception)) :result )
   1.194 +
   1.195 +  ; identity (= (cond true x) x)
   1.196 +  (maintains-identity (fn [_] (cond true _))) )
   1.197 +
   1.198 +
   1.199 +(deftest test-condp
   1.200 +  (are [x] (= :pass x)
   1.201 +       (condp = 1
   1.202 +         1 :pass
   1.203 +         2 :fail)
   1.204 +       (condp = 1
   1.205 +         2 :fail
   1.206 +         1 :pass)
   1.207 +       (condp = 1
   1.208 +         2 :fail
   1.209 +         :pass)
   1.210 +       (condp = 1
   1.211 +         :pass)
   1.212 +       (condp = 1
   1.213 +         2 :fail
   1.214 +         ;; doc of condp says result-expr is returned
   1.215 +         ;; shouldn't it say similar to cond: "evaluates and returns
   1.216 +         ;; the value of the corresponding expr and doesn't evaluate any of the
   1.217 +         ;; other tests or exprs."
   1.218 +         (identity :pass))
   1.219 +       (condp + 1
   1.220 +         1 :>> #(if (= % 2) :pass :fail))
   1.221 +       (condp + 1
   1.222 +         1 :>> #(if (= % 3) :fail :pass))
   1.223 +       )
   1.224 +  (is (thrown? IllegalArgumentException
   1.225 +               (condp = 1)
   1.226 +               ))
   1.227 +  (is (thrown? IllegalArgumentException
   1.228 +               (condp = 1
   1.229 +                 2 :fail)
   1.230 +               ))
   1.231 +  )
   1.232 +
   1.233 +
   1.234 +; [for, doseq (for.clj)]
   1.235 +
   1.236 +(deftest test-dotimes
   1.237 +  ;; dotimes always returns nil
   1.238 +  (is (= nil (dotimes [n 1] n)))
   1.239 +  ;; test using an atom since dotimes is for modifying
   1.240 +  ;; test executes n times
   1.241 +  (is (= 3
   1.242 +         (let [a (atom 0)]
   1.243 +           (dotimes [n 3]
   1.244 +             (swap! a inc))
   1.245 +           @a)
   1.246 +         ))
   1.247 +  ;; test all values of n
   1.248 +  (is (= [0 1 2]
   1.249 +         (let [a (atom [])]
   1.250 +           (dotimes [n 3]
   1.251 +             (swap! a conj n))
   1.252 +           @a)))
   1.253 +  (is (= []
   1.254 +         (let [a (atom [])]
   1.255 +           (dotimes [n 0]
   1.256 +             (swap! a conj n))
   1.257 +           @a)))
   1.258 +  )
   1.259 +
   1.260 +(deftest test-while
   1.261 +  (is (= nil (while nil (throw (Exception. "never")))))
   1.262 +  (is (= [0 nil]
   1.263 +         ;; a will dec to 0
   1.264 +         ;; while always returns nil
   1.265 +         (let [a (atom 3)
   1.266 +               w (while (pos? @a)
   1.267 +                   (swap! a dec))]
   1.268 +           [@a w])))
   1.269 +  (is (thrown? Exception (while true (throw (Exception. "expected to throw")))))
   1.270 +  )
   1.271 +
   1.272 +; locking, monitor-enter, monitor-exit
   1.273 +
   1.274 +; case 
   1.275 +(deftest test-case
   1.276 +  (testing "can match many kinds of things"
   1.277 +    (let [two 2
   1.278 +          test-fn
   1.279 +          #(case %
   1.280 +                 1 :number
   1.281 +                 "foo" :string
   1.282 +                 \a :char
   1.283 +                 pow :symbol
   1.284 +                 :zap :keyword
   1.285 +                 (2 \b "bar") :one-of-many
   1.286 +                 [1 2] :sequential-thing
   1.287 +                 {:a 2} :map
   1.288 +                 {:r 2 :d 2} :droid
   1.289 +                 #{2 3 4 5} :set
   1.290 +                 [1 [[[2]]]] :deeply-nested
   1.291 +                 :default)]
   1.292 +      (are [result input] (= result (test-fn input))
   1.293 +           :number 1
   1.294 +           :string "foo"
   1.295 +           :char \a
   1.296 +           :keyword :zap
   1.297 +           :symbol 'pow
   1.298 +           :one-of-many 2
   1.299 +           :one-of-many \b
   1.300 +           :one-of-many "bar"
   1.301 +           :sequential-thing [1 2]
   1.302 +           :sequential-thing (list 1 2)
   1.303 +           :sequential-thing [1 two]
   1.304 +           :map {:a 2}
   1.305 +           :map {:a two}
   1.306 +           :set #{2 3 4 5}
   1.307 +           :set #{two 3 4 5}
   1.308 +           :default #{2 3 4 5 6}
   1.309 +           :droid {:r 2 :d 2}
   1.310 +           :deeply-nested [1 [[[two]]]]
   1.311 +           :default :anything-not-appearing-above)))
   1.312 +  (testing "throws IllegalArgumentException if no match"
   1.313 +    (is (thrown-with-msg?
   1.314 +          IllegalArgumentException #"No matching clause: 2"
   1.315 +          (case 2 1 :ok))))
   1.316 +  (testing "sorting doesn't matter"
   1.317 +    (let [test-fn
   1.318 +          #(case %
   1.319 +                {:b 2 :a 1} :map
   1.320 +                #{3 2 1} :set
   1.321 +                :default)]
   1.322 +      (are [result input] (= result (test-fn input))
   1.323 +           :map {:a 1 :b 2}
   1.324 +           :map (sorted-map :a 1 :b 2)
   1.325 +           :set #{3 2 1}
   1.326 +           :set (sorted-set 2 1 3))))
   1.327 +  (testing "test constants are *not* evaluated"
   1.328 +    (let [test-fn
   1.329 +          ;; never write code like this...
   1.330 +          #(case %
   1.331 +                 (throw (RuntimeException. "boom")) :piece-of-throw-expr
   1.332 +                 :no-match)]
   1.333 +      (are [result input] (= result (test-fn input))
   1.334 +           :piece-of-throw-expr 'throw
   1.335 +           :piece-of-throw-expr '[RuntimeException. "boom"]
   1.336 +           :no-match nil))))