alvinalexander.com | career | drupal | java | mac | mysql | perl | scala | uml | unix  

Java example source code file (control.clj)

This example Java source code file (control.clj) is included in the alvinalexander.com "Java Source Code Warehouse" project. The intent of this project is to help you "Learn Java by Example" TM.

Learn more about this Java project at its project page.

Java - Java tags/keywords

exception, halloway, helper, hinchey, illegalargumentexception, long, mike, object, oops, performance, public, runtimeexception, you

The control.clj Java example source code

;   Copyright (c) Rich Hickey. All rights reserved.
;   The use and distribution terms for this software are covered by the
;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;   which can be found in the file epl-v10.html at the root of this distribution.
;   By using this software in any fashion, you are agreeing to be bound by
;   the terms of this license.
;   You must not remove this notice, or any other, from this software.

; Author: Frantisek Sodomka, Mike Hinchey, Stuart Halloway

;;
;;  Test "flow control" constructs.
;;

(ns clojure.test-clojure.control
  (:use clojure.test
        clojure.test-helper))

;; *** Helper functions ***

(defn maintains-identity [f]
  (are [x] (= (f x) x)
      nil
      false true
      0 42
      0.0 3.14
      2/3
      0M 1M
      \c
      "" "abc"
      'sym
      :kw
      () '(1 2)
      [] [1 2]
      {} {:a 1 :b 2}
      #{} #{1 2} ))


; http://clojure.org/special_forms
; http://clojure.org/macros

(deftest test-do
  (are [x y] (= x y)
      ; no params => nil
      (do) nil
      
      ; return last
      (do 1) 1
      (do 1 2) 2
      (do 1 2 3 4 5) 5
      
      ; evaluate and return last
      (let [a (atom 0)]
        (do (reset! a (+ @a 1))   ; 1
            (reset! a (+ @a 1))   ; 2
            (reset! a (+ @a 1))   ; 3
            @a))  3 )

  ; identity (= (do x) x)
  (maintains-identity (fn [_] (do _))) )


;; loop/recur
(deftest test-loop
  (are [x y] (= x y)
       1 (loop []
           1)
       3 (loop [a 1]
           (if (< a 3)
             (recur (inc a))
             a))
       [2 4 6] (loop [a []
                      b [1 2 3]]
                 (if (seq b)
                   (recur (conj a (* 2 (first b)))
                          (next b))
                   a))
       [6 4 2] (loop [a ()
                      b [1 2 3]]
                 (if (seq b)
                   (recur (conj a (* 2 (first b)))
                          (next b))
                   a))
       )
  )


;; throw, try

; if: see logic.clj

(deftest test-when
  (are [x y] (= x y)
       1 (when true 1)
       nil (when true)
       nil (when false)
       nil (when false (exception))
       ))

(deftest test-when-not
  (are [x y] (= x y)
       1 (when-not false 1)
       nil (when-not true)
       nil (when-not false)
       nil (when-not true (exception))
       ))

(deftest test-if-not
  (are [x y] (= x y)
       1 (if-not false 1)
       1 (if-not false 1 (exception))
       nil (if-not true 1)
       2 (if-not true 1 2)
       nil (if-not true (exception))
       1 (if-not true (exception) 1)
       ))

(deftest test-when-let
  (are [x y] (= x y)
       1 (when-let [a 1]
           a)
       2 (when-let [[a b] '(1 2)]
           b)
       nil (when-let [a false]
             (exception))
       ))

(deftest test-if-let
  (are [x y] (= x y)
       1 (if-let [a 1]
           a)
       2 (if-let [[a b] '(1 2)]
           b)
       nil (if-let [a false]
             (exception))
       1 (if-let [a false]
           a 1)
       1 (if-let [[a b] nil]
             b 1)
       1 (if-let [a false]
           (exception)
           1)
       ))

(deftest test-when-first
  (are [x y] (= x y)
       1 (when-first [a [1 2]]
           a)
       2 (when-first [[a b] '((1 2) 3)]
           b)
       nil (when-first [a nil]
             (exception))
       ))

(deftest test-if-some
  (are [x y] (= x y)
       1 (if-some [a 1] a)
       false (if-some [a false] a)
       nil (if-some [a nil] (exception))
       3 (if-some [[a b] [1 2]] (+ a b))
       1 (if-some [[a b] nil] b 1)
       1 (if-some [a nil] (exception) 1)))

(deftest test-when-some
  (are [x y] (= x y)
       1 (when-some [a 1] a)
       2 (when-some [[a b] [1 2]] b)
       false (when-some [a false] a)
       nil (when-some [a nil] (exception))))

(deftest test-cond
  (are [x y] (= x y)
      (cond) nil

      (cond nil true) nil
      (cond false true) nil
      
      (cond true 1 true (exception)) 1
      (cond nil 1 false 2 true 3 true 4) 3
      (cond nil 1 false 2 true 3 true (exception)) 3 )

  ; false
  (are [x]  (= (cond x :a true :b) :b)
      nil false )

  ; true
  (are [x]  (= (cond x :a true :b) :a)
      true
      0 42
      0.0 3.14
      2/3
      0M 1M
      \c
      "" "abc"
      'sym
      :kw
      () '(1 2)
      [] [1 2]
      {} {:a 1 :b 2}
      #{} #{1 2} )

  ; evaluation
  (are [x y] (= x y)
      (cond (> 3 2) (+ 1 2) true :result true (exception)) 3
      (cond (< 3 2) (+ 1 2) true :result true (exception)) :result )

  ; identity (= (cond true x) x)
  (maintains-identity (fn [_] (cond true _))) )


(deftest test-condp
  (are [x] (= :pass x)
       (condp = 1
         1 :pass
         2 :fail)
       (condp = 1
         2 :fail
         1 :pass)
       (condp = 1
         2 :fail
         :pass)
       (condp = 1
         :pass)
       (condp = 1
         2 :fail
         ;; doc of condp says result-expr is returned
         ;; shouldn't it say similar to cond: "evaluates and returns
         ;; the value of the corresponding expr and doesn't evaluate any of the
         ;; other tests or exprs."
         (identity :pass))
       (condp + 1
         1 :>> #(if (= % 2) :pass :fail))
       (condp + 1
         1 :>> #(if (= % 3) :fail :pass))
       )
  (is (thrown? IllegalArgumentException
               (condp = 1)
               ))
  (is (thrown? IllegalArgumentException
               (condp = 1
                 2 :fail)
               ))
  )


; [for, doseq (for.clj)]

(deftest test-dotimes
  ;; dotimes always returns nil
  (is (= nil (dotimes [n 1] n)))
  ;; test using an atom since dotimes is for modifying
  ;; test executes n times
  (is (= 3
         (let [a (atom 0)]
           (dotimes [n 3]
             (swap! a inc))
           @a)
         ))
  ;; test all values of n
  (is (= [0 1 2]
         (let [a (atom [])]
           (dotimes [n 3]
             (swap! a conj n))
           @a)))
  (is (= []
         (let [a (atom [])]
           (dotimes [n 0]
             (swap! a conj n))
           @a)))
  )

(deftest test-while
  (is (= nil (while nil (throw (Exception. "never")))))
  (is (= [0 nil]
         ;; a will dec to 0
         ;; while always returns nil
         (let [a (atom 3)
               w (while (pos? @a)
                   (swap! a dec))]
           [@a w])))
  (is (thrown? Exception (while true (throw (Exception. "expected to throw")))))
  )

; locking, monitor-enter, monitor-exit

; case 
(deftest test-case
  (testing "can match many kinds of things"
    (let [two 2
          test-fn
          #(case %
                 1 :number
                 "foo" :string
                 \a :char
                 pow :symbol
                 :zap :keyword
                 (2 \b "bar") :one-of-many
                 [1 2] :sequential-thing
                 {:a 2} :map
                 {:r 2 :d 2} :droid
                 #{2 3 4 5} :set
                 [1 [[[2]]]] :deeply-nested
                 nil :nil
                 :default)]
      (are [result input] (= result (test-fn input))
           :number 1
           :string "foo"
           :char \a
           :keyword :zap
           :symbol 'pow
           :one-of-many 2
           :one-of-many \b
           :one-of-many "bar"
           :sequential-thing [1 2]
           :sequential-thing (list 1 2)
           :sequential-thing [1 two]
           :map {:a 2}
           :map {:a two}
           :set #{2 3 4 5}
           :set #{two 3 4 5}
           :default #{2 3 4 5 6}
           :droid {:r 2 :d 2}
           :deeply-nested [1 [[[two]]]]
           :nil nil
           :default :anything-not-appearing-above)))
  (testing "throws IllegalArgumentException if no match"
    (is (thrown-with-msg?
          IllegalArgumentException #"No matching clause: 2"
          (case 2 1 :ok))))
  (testing "sorting doesn't matter"
    (let [test-fn
          #(case %
                {:b 2 :a 1} :map
                #{3 2 1} :set
                :default)]
      (are [result input] (= result (test-fn input))
           :map {:a 1 :b 2}
           :map (sorted-map :a 1 :b 2)
           :set #{3 2 1}
           :set (sorted-set 2 1 3))))
  (testing "test number equivalence"
    (is (= :1 (case 1N 1 :1 :else))))
  (testing "test warn when boxing/hashing expr for all-ints case"
    (should-print-err-message
      #"Performance warning, .*:\d+ - case has int tests, but tested expression is not primitive..*\r?\n"
      (let [x (Object.)] (case x 1 1 2))))
  (testing "test correct behavior on sparse ints"
    (are [result input] (= result (case input
                                    2r1000000000000000000000000000000 :big
                                    1 :small
                                    :else))
         :small 1
         :big 1073741824
         :else 2)
    (are [result input] (= result (case input
                                    1 :small
                                    2r1000000000000000000000000000000 :big
                                    :else))
         :small 1
         :big 1073741824
         :else 2))
  (testing "test emits return types"
    (should-not-reflect (Long. (case 1 1 1))) ; new Long(long)
    (should-not-reflect (Long. (case 1 1 "1")))) ; new Long(String)
  (testing "non-equivalence of chars and nums"
    (are [result input] (= result (case input 97 :97 :else))
      :else \a
      :else (char \a)
      :97 (int \a))
    (are [result input] (= result (case input \a :a :else))
      :else 97
      :else 97N
      :a (char 97)))
  (testing "test error on duplicate test constants"
    (is (thrown-with-msg?
          IllegalArgumentException
          #"Duplicate case test constant: 1"
          (eval `(case 0 1 :x 1 :y)))))
  (testing "test correct behaviour on Number truncation"
    (let [^Object x (Long. 8589934591)  ; force bindings to not be emitted as a primitive long
          ^Object y (Long. -1)]
      (is (= :diff (case x -1 :oops :diff)))
      (is (= :same (case y -1 :same :oops)))))
  (testing "test correct behavior on hash collision"
    ;; case uses Java .hashCode to put values into hash buckets.
    (is (== (.hashCode 1) (.hashCode 9223372039002259457N)))
    (are [result input] (= result (case input
                                    1 :long
                                    9223372039002259457N :big
                                    :else))
         :long 1
         :big 9223372039002259457N
         :else 4294967296
         :else 2)
    (are [result input] (= result (case input
                                    9223372039002259457N :big
                                    1 :long
                                    :else))
         :long 1
         :big 9223372039002259457N
         :else 4294967296
         :else 2)
    (are [result input] (= result (case input
                                    0 :zero
                                    -1 :neg1
                                    2 :two
                                    :oops :OOPS))
         :zero 0
         :neg1 -1
         :two 2
         :OOPS :oops)
    (are [result input] (= result (case input
                                    1204766517646190306 :a
                                    1 :b
                                    -2 :c
                                    :d))
         :a 1204766517646190306
         :b 1
         :c -2
         :d 4294967296
         :d 3))
  (testing "test warn for hash collision"
    (should-print-err-message
     #"Performance warning, .*:\d+ - hash collision of some case test constants; if selected, those entries will be tested sequentially..*\r?\n"
     (case 1 1 :long 9223372039002259457N :big 2)))
  (testing "test constants are *not* evaluated"
    (let [test-fn
          ;; never write code like this...
          #(case %
                 (throw (RuntimeException. "boom")) :piece-of-throw-expr
                 :no-match)]
      (are [result input] (= result (test-fn input))
           :piece-of-throw-expr 'throw
           :piece-of-throw-expr '[RuntimeException. "boom"]
           :no-match nil))))

Other Java examples (source code examples)

Here is a short list of links related to this Java control.clj source code file:

... this post is sponsored by my books ...

#1 New Release!

FP Best Seller

 

new blog posts

 

Copyright 1998-2021 Alvin Alexander, alvinalexander.com
All Rights Reserved.

A percentage of advertising revenue from
pages under the /java/jwarehouse URI on this website is
paid back to open source projects.