Back
deftest (clj)
(source)macro
(deftest name & body)
Defines a test function with no arguments. Test functions may call
other tests, so tests may be composed. If you compose tests, you
should also define a function named test-ns-hook; run-tests will
call test-ns-hook instead of testing all vars.
Note: Actually, the test body goes in the :test metadata on the var,
and the real function (the value of the var) calls test-var on
itself.
When *load-tests* is false, deftest is ignored.
Examples
clojure
(ns clojure.test-clojure.transducers
(:require [clojure.string :as s]
[clojure.test :refer :all]
[clojure.test.check :as chk]
[clojure.test.check.generators :as gen]
[clojure.test.check.properties :as prop]
[clojure.test.check.clojure-test :as ctest]))
(deftest seq-and-transducer
(let [res (chk/quick-check
200000
(prop/for-all* [result-gen] result-good?))]
(when-not (:result res)
(is
(:result res)
(->
res
:shrunk
:smallest
first
clojure.pprint/pprint
with-out-str)))))
(deftest test-transduce
(let [long+ (fn ([a b] (+ (long a) (long b)))
([a] a)
([] 0))
mapinc (map inc)
mapinclong (map (comp inc long))
arange (range 100)
avec (into [] arange)
alist (into () arange)
obj-array (into-array arange)
int-array (into-array Integer/TYPE (map #(Integer. (int %)) arange))
long-array (into-array Long/TYPE arange)
float-array (into-array Float/TYPE arange)
char-array (into-array Character/TYPE (map char arange))
double-array (into-array Double/TYPE arange)
byte-array (into-array Byte/TYPE (map byte arange))
int-vec (into (vector-of :int) arange)
long-vec (into (vector-of :long) arange)
float-vec (into (vector-of :float) arange)
char-vec (into (vector-of :char) (map char arange))
double-vec (into (vector-of :double) arange)
byte-vec (into (vector-of :byte) (map byte arange))]
(is (== 5050
(transduce mapinc + arange)
(transduce mapinc + avec)
(transduce mapinc + alist)
(transduce mapinc + obj-array)
(transduce mapinc + int-array)
(transduce mapinc + long-array)
(transduce mapinc + float-array)
(transduce mapinclong + char-array)
(transduce mapinc + double-array)
(transduce mapinclong + byte-array)
(transduce mapinc + int-vec)
(transduce mapinc + long-vec)
(transduce mapinc + float-vec)
(transduce mapinclong + char-vec)
(transduce mapinc + double-vec)
(transduce mapinclong + byte-vec)
))
(is (== 5051
(transduce mapinc + 1 arange)
(transduce mapinc + 1 avec)
(transduce mapinc + 1 alist)
(transduce mapinc + 1 obj-array)
(transduce mapinc + 1 int-array)
(transduce mapinc + 1 long-array)
(transduce mapinc + 1 float-array)
(transduce mapinclong + 1 char-array)
(transduce mapinc + 1 double-array)
(transduce mapinclong + 1 byte-array)
(transduce mapinc + 1 int-vec)
(transduce mapinc + 1 long-vec)
(transduce mapinc + 1 float-vec)
(transduce mapinclong + 1 char-vec)
(transduce mapinc + 1 double-vec)
(transduce mapinclong + 1 byte-vec)))))
(deftest test-dedupe
(are [x y] (= (transduce (dedupe) conj x) y)
[] []
[1] [1]
[1 2 3] [1 2 3]
[1 2 3 1 2 2 1 1] [1 2 3 1 2 1]
[1 1 1 2] [1 2]
[1 1 1 1] [1]
(deftest test-cat
(are [x y] (= (transduce cat conj x) y)
[] []
[[1 2]] [1 2]
[[1 2] [3 4]] [1 2 3 4]
[[] [3 4]] [3 4]
[[1 2] []] [1 2]
[[] []] []
[[1 2] [3 4] [5 6]] [1 2 3 4 5 6]))
(deftest test-partition-all
(are [n coll y] (= (transduce (partition-all n) conj coll) y)
2 [1 2 3] '((1 2) (3))
2 [1 2 3 4] '((1 2) (3 4))
2 [] ()
1 [] ()
1 [1 2 3] '((1) (2) (3))
5 [1 2 3] '((1 2 3))))
(deftest test-take
(are [n y] (= (transduce (take n) conj [1 2 3 4 5]) y)
1 '(1)
3 '(1 2 3)
5 '(1 2 3 4 5)
9 '(1 2 3 4 5)
0 ()
-1 ()
-2 ()))
(deftest test-drop
(are [n y] (= (transduce (drop n) conj [1 2 3 4 5]) y)
1 '(2 3 4 5)
3 '(4 5)
5 ()
9 ()
0 '(1 2 3 4 5)
-1 '(1 2 3 4 5)
-2 '(1 2 3 4 5)))
(deftest test-take-nth
(are [n y] (= (transduce (take-nth n) conj [1 2 3 4 5]) y)
1 '(1 2 3 4 5)
2 '(1 3 5)
3 '(1 4)
4 '(1 5)
5 '(1)
9 '(1)))
(deftest test-take-while
(are [coll y] (= (transduce (take-while pos?) conj coll) y)
[] ()
[1 2 3 4] '(1 2 3 4)
[1 2 3 -1] '(1 2 3)
[1 -1 2 3] '(1)
[-1 1 2 3] ()
[-1 -2 -3] ()))
(deftest test-drop-while
(are [coll y] (= (transduce (drop-while pos?) conj coll) y)
[] ()
[1 2 3 4] ()
[1 2 3 -1] '(-1)
[1 -1 2 3] '(-1 2 3)
[-1 1 2 3] '(-1 1 2 3)
[-1 -2 -3] '(-1 -2 -3)))
(deftest test-re-reduced
(is (= [:a] (transduce (take 1) conj [:a])))
(is (= [:a] (transduce (comp (take 1) (take 1)) conj [:a])))
(is (= [:a] (transduce (comp (take 1) (take 1) (take 1)) conj [:a])))
(is (= [:a] (transduce (comp (take 1) (take 1) (take 1) (take 1)) conj [:a])))
(is (= [[:a]] (transduce (comp (partition-by keyword?) (take 1)) conj [] [:a])))
(is (= [[:a]] (sequence (comp (partition-by keyword?) (take 1)) [:a])))
(is (= [[[:a]]] (sequence (comp (partition-by keyword?) (take 1) (partition-by keyword?) (take 1)) [:a])))
(is (= [[0]] (transduce (comp (take 1) (partition-all 3) (take 1)) conj [] (range 15))))
(is (= [1] (transduce (take 1) conj (seq (long-array [1 2 3 4]))))))
(deftest test-sequence-multi-xform
(is (= [11 12 13 14] (sequence (map +) [1 2 3 4] (repeat 10))))
(is (= [11 12 13 14] (sequence (map +) (repeat 10) [1 2 3 4])))
(is (= [31 32 33 34] (sequence (map +) (repeat 10) (repeat 20) [1 2 3 4]))))
(deftest test-eduction
(testing "one xform"
(is (= [1 2 3 4 5]
(eduction (map inc) (range 5)))))
(testing "multiple xforms"
(is (= ["2" "4"]
(eduction (map inc) (filter even?) (map str) (range 5)))))
(testing "materialize at the end"
(is (= [1 1 1 1 2 2 2 3 3 4]
(->> (range 5)
(eduction (mapcat range) (map inc))
sort)))
(is (= [1 1 2 1 2 3 1 2 3 4]
(vec (->> (range 5)
(eduction (mapcat range) (map inc))
to-array))))
(is (= {1 4, 2 3, 3 2, 4 1}
(->> (range 5)
(eduction (mapcat range) (map inc))
frequencies)))
(is (= ["drib" "god" "hsif" "kravdraa" "tac"]
(->> ["cat" "dog" "fish" "bird" "aardvark"]
(eduction (map clojure.string/reverse))
(sort-by first)))))
(testing "expanding transducer with nils"
(is (= '(1 2 3 nil 4 5 6 nil)
(eduction cat [[1 2 3 nil] [4 5 6 nil]])))))
(deftest test-eduction-completion
(testing "eduction completes inner xformed reducing fn"
(is (= [[0 1 2] [3 4 5] [6 7]]
(into []
(comp cat (partition-all 3))
(eduction (partition-all 5) (range 8))))))
(testing "outer reducing fn completed only once"
(let [counter (atom 0)
;; outer rfn
rf (completing conj #(do (swap! counter inc)
(vec %)))
coll (eduction (map inc) (range 5))
res (transduce (map str) rf [] coll)]
(is (= 1 @counter))
(is (= ["1" "2" "3" "4" "5"] res)))))
(deftest test-run!
(is (nil? (run! identity [1])))
(is (nil? (run! reduced (range)))))
(deftest test-distinct
(are [out in] (= out (sequence (distinct in)) (sequence (distinct) in))
[] []
(range 10) (range 10)
[0] (repeat 10 0)
[0 1 2] [0 0 1 1 2 2 1 1 0 0]
[1] [1 1N]))
(deftest test-interpose
(are [out in] (= out (sequence (interpose :s) in))
[] (range 0)
[0] (range 1)
[0 :s 1] (range 2)
[0 :s 1 :s 2] (range 3))
(testing "Can end reduction on separator or input"
(let [expected (interpose :s (range))]
(dotimes [i 10]
(is (= (take i expected)
(sequence (comp (interpose :s) (take i))
(range))))))))
(deftest test-map-indexed
(is (= []
(sequence (map-indexed vector) [])))
(is (= [[0 1] [1 2] [2 3] [3 4]]
(sequence (map-indexed vector) (range 1 5)))))
(deftest test-into+halt-when
(is (= :anomaly (into [] (comp (filter some?) (halt-when #{:anomaly}))
[1 2 3 :anomaly 4])))
(is (= {:anomaly :oh-no!,
:partial-results [1 2]}
(into []
(halt-when :anomaly #(assoc %2 :partial-results %1))
[1 2 {:anomaly :oh-no!} 3 4]))))
clojure
(ns clojure.test-clojure.string
(:require [clojure.string :as s])
(:use clojure.test))
(deftest t-split
(is (= ["a" "b"] (s/split "a-b" #"-")))
(is (= ["a" "b-c"] (s/split "a-b-c" #"-" 2)))
(is (vector? (s/split "abc" #"-"))))
(deftest t-reverse
(is (= "tab" (s/reverse "bat"))))
(deftest t-replace
(is (= "faabar" (s/replace "foobar" \o \a)))
(is (= "foobar" (s/replace "foobar" \z \a)))
(is (= "barbarbar" (s/replace "foobarfoo" "foo" "bar")))
(is (= "foobarfoo" (s/replace "foobarfoo" "baz" "bar")))
(is (= "f$$d" (s/replace "food" "o" "$")))
(is (= "f\\\\d" (s/replace "food" "o" "\\")))
(is (= "barbarbar" (s/replace "foobarfoo" #"foo" "bar")))
(is (= "foobarfoo" (s/replace "foobarfoo" #"baz" "bar")))
(is (= "f$$d" (s/replace "food" #"o" (s/re-quote-replacement "$"))))
(is (= "f\\\\d" (s/replace "food" #"o" (s/re-quote-replacement "\\"))))
(is (= "FOObarFOO" (s/replace "foobarfoo" #"foo" s/upper-case)))
(is (= "foobarfoo" (s/replace "foobarfoo" #"baz" s/upper-case)))
(is (= "OObarOO" (s/replace "foobarfoo" #"f(o+)" (fn [[m g1]] (s/upper-case g1)))))
(is (= "baz\\bang\\" (s/replace "bazslashbangslash" #"slash" (constantly "\\")))))
(deftest t-replace-first
(is (= "faobar" (s/replace-first "foobar" \o \a)))
(is (= "foobar" (s/replace-first "foobar" \z \a)))
(is (= "z.ology" (s/replace-first "zoology" \o \.)))
(is (= "barbarfoo" (s/replace-first "foobarfoo" "foo" "bar")))
(is (= "foobarfoo" (s/replace-first "foobarfoo" "baz" "bar")))
(is (= "f$od" (s/replace-first "food" "o" "$")))
(is (= "f\\od" (s/replace-first "food" "o" "\\")))
(is (= "barbarfoo" (s/replace-first "foobarfoo" #"foo" "bar")))
(is (= "foobarfoo" (s/replace-first "foobarfoo" #"baz" "bar")))
(is (= "f$od" (s/replace-first "food" #"o" (s/re-quote-replacement "$"))))
(is (= "f\\od" (s/replace-first "food" #"o" (s/re-quote-replacement "\\"))))
(is (= "FOObarfoo" (s/replace-first "foobarfoo" #"foo" s/upper-case)))
(is (= "foobarfoo" (s/replace-first "foobarfoo" #"baz" s/upper-case)))
(is (= "OObarfoo" (s/replace-first "foobarfoo" #"f(o+)" (fn [[m g1]] (s/upper-case g1)))))
(is (= "baz\\bangslash" (s/replace-first "bazslashbangslash" #"slash" (constantly "\\")))))
(deftest t-join
(are [x coll] (= x (s/join coll))
"" nil
"" []
"1" [1]
"12" [1 2])
(are [x sep coll] (= x (s/join sep coll))
"1,2,3" \, [1 2 3]
"" \, []
"1" \, [1]
"1 and-a 2 and-a 3" " and-a " [1 2 3]))
(deftest t-trim-newline
(is (= "foo" (s/trim-newline "foo\n")))
(is (= "foo" (s/trim-newline "foo\r\n")))
(is (= "foo" (s/trim-newline "foo")))
(is (= "" (s/trim-newline ""))))
(deftest t-capitalize
(is (= "Foobar" (s/capitalize "foobar")))
(is (= "Foobar" (s/capitalize "FOOBAR"))))
(deftest t-triml
(is (= "foo " (s/triml " foo ")))
(is (= "" (s/triml " ")))
(is (= "bar" (s/triml "\u2002 \tbar"))))
(deftest t-trimr
(is (= " foo" (s/trimr " foo ")))
(is (= "" (s/trimr " ")))
(is (= "bar" (s/trimr "bar\t \u2002"))))
(deftest t-trim
(is (= "foo" (s/trim " foo \r\n")))
(is (= "bar" (s/trim "\u2000bar\t \u2002"))))
(deftest t-upper-case
(is (= "FOOBAR" (s/upper-case "Foobar"))))
(deftest t-lower-case
(is (= "foobar" (s/lower-case "FooBar"))))
(deftest nil-handling
(are [f args] (thrown? NullPointerException (apply f args))
s/reverse [nil]
s/replace [nil #"foo" "bar"]
s/replace-first [nil #"foo" "bar"]
s/re-quote-replacement [nil]
s/capitalize [nil]
s/upper-case [nil]
s/lower-case [nil]
s/split [nil #"-"]
s/split [nil #"-" 1]
s/trim [nil]
s/triml [nil]
s/trimr [nil]
s/trim-newline [nil]))
(deftest char-sequence-handling
(are [result f args] (let [[^CharSequence s & more] args]
(= result (apply f (StringBuffer. s) more)))
"paz" s/reverse ["zap"]
"foo:bar" s/replace ["foo-bar" \- \:]
"ABC" s/replace ["abc" #"\w" s/upper-case]
"faa" s/replace ["foo" #"o" (StringBuffer. "a")]
"baz::quux" s/replace-first ["baz--quux" #"--" "::"]
"baz::quux" s/replace-first ["baz--quux" (StringBuffer. "--") (StringBuffer. "::")]
"zim-zam" s/replace-first ["zim zam" #" " (StringBuffer. "-")]
"\\\\ \\$" s/re-quote-replacement ["\\ $"]
"Pow" s/capitalize ["POW"]
"BOOM" s/upper-case ["boom"]
"whimper" s/lower-case ["whimPER"]
["foo" "bar"] s/split ["foo-bar" #"-"]
"calvino" s/trim [" calvino "]
"calvino " s/triml [" calvino "]
" calvino" s/trimr [" calvino "]
"the end" s/trim-newline ["the end\r\n\r\r\n"]
true s/blank? [" "]
["a" "b"] s/split-lines ["a\nb"]
"fa la la" s/escape ["fo lo lo" {\o \a}]))
(deftest t-escape
(is (= "<foo&bar>"
(s/escape "<foo&bar>" {\& "&" \< "<" \> ">"})))
(is (= " \\\"foo\\\" "
(s/escape " \"foo\" " {\" "\\\""})))
(is (= "faabor"
(s/escape "foobar" {\a \o, \o \a}))))
(deftest t-blank
(is (s/blank? nil))
(is (s/blank? ""))
(is (s/blank? " "))
(is (s/blank? " \t \n \r "))
(is (not (s/blank? " foo "))))
(deftest t-split-lines
(let [result (s/split-lines "one\ntwo\r\nthree")]
(is (= ["one" "two" "three"] result))
(is (vector? result)))
(is (= (list "foo") (s/split-lines "foo"))))
(deftest t-index-of
(let [sb (StringBuffer. "tacos")]
(is (= 2 (s/index-of sb "c")))
(is (= 2 (s/index-of sb \c)))
(is (= 1 (s/index-of sb "ac")))
(is (= 3 (s/index-of sb "o" 2)))
(is (= 3 (s/index-of sb \o 2)))
(is (= 3 (s/index-of sb "o" -100)))
(is (= nil (s/index-of sb "z")))
(is (= nil (s/index-of sb \z)))
(is (= nil (s/index-of sb "z" 2)))
(is (= nil (s/index-of sb \z 2)))
(is (= nil (s/index-of sb "z" 100))
(is (= nil (s/index-of sb "z" -10))))))
(deftest t-last-index-of
(let [sb (StringBuffer. "banana")]
(is (= 4 (s/last-index-of sb "n")))
(is (= 4 (s/last-index-of sb \n)))
(is (= 3 (s/last-index-of sb "an")))
(is (= 4 (s/last-index-of sb "n" )))
(is (= 4 (s/last-index-of sb "n" 5)))
(is (= 4 (s/last-index-of sb \n 5)))
(is (= 4 (s/last-index-of sb "n" 500)))
(is (= nil (s/last-index-of sb "z")))
(is (= nil (s/last-index-of sb "z" 1)))
(is (= nil (s/last-index-of sb \z 1)))
(is (= nil (s/last-index-of sb "z" 100))
(is (= nil (s/last-index-of sb "z" -10))))))
(deftest t-starts-with?
(is (s/starts-with? (StringBuffer. "clojure west") "clojure"))
(is (not (s/starts-with? (StringBuffer. "conj") "clojure"))))
(deftest t-ends-with?
(is (s/ends-with? (StringBuffer. "Clojure West") "West")
(is (not (s/ends-with? (StringBuffer. "Conj") "West")))))
(deftest t-includes?
(let [sb (StringBuffer. "Clojure Applied Book")]
(is (s/includes? sb "Applied"))
(is (not (s/includes? sb "Living")))))
(deftest empty-collections
(is (= "()" (str ())))
(is (= "{}" (str {})))
(is (= "[]" (str []))))
clojure
(ns clojure.test-clojure.special
(:use clojure.test)
(:require [clojure.test-helper :refer [should-not-reflect]]))
(deftest multiple-keys-in-destructuring
(let [foo (fn [& {:keys [x]}] x)
bar (fn [& options] (apply foo :x :b options))]
(is (= (bar) :b))
(is (= (bar :x :a) :a))))
(deftest empty-list-with-:as-destructuring
(let [{:as x} '()]
(is (= {} x))))
(deftest keywords-in-destructuring
(let [m {:a 1 :b 2}]
(let [{:keys [:a :b]} m]
(is (= [1 2] [a b])))
(let [{:keys [:a :b :c] :or {c 3}} m]
(is (= [1 2 3] [a b c])))))
(deftest namespaced-keywords-in-destructuring
(let [m {:a/b 1 :c/d 2}]
(let [{:keys [:a/b :c/d]} m]
(is (= [1 2] [b d])))
(let [{:keys [:a/b :c/d :e/f] :or {f 3}} m]
(is (= [1 2 3] [b d f])))))
(deftest namespaced-keys-in-destructuring
(let [m {:a/b 1 :c/d 2}]
(let [{:keys [a/b c/d]} m]
(is (= [1 2] [b d])))
(let [{:keys [a/b c/d e/f] :or {f 3}} m]
(is (= [1 2 3] [b d f])))))
(deftest namespaced-syms-in-destructuring
(let [{:syms [a/b c/d e/f] :or {f 3}} {'a/b 1 'c/d 2}]
(is (= [1 2 3] [b d f]))))
(deftest namespaced-keys-syntax
(let [{:a/keys [b c d] :or {d 3}} {:a/b 1 :a/c 2}]
(is (= [1 2 3] [b c d]))))
(deftest namespaced-syms-syntax
(let [{:a/syms [b c d] :or {d 3}} {'a/b 1 'a/c 2}]
(is (= [1 2 3] [b c d]))))
(deftest keywords-not-allowed-in-let-bindings
(is (thrown-with-cause-msg? Exception #"did not conform to spec"
(eval '(let [:a 1] a))))
(is (thrown-with-cause-msg? Exception #"did not conform to spec"
(eval '(let [:a/b 1] b))))
(is (thrown-with-cause-msg? Exception #"did not conform to spec"
(eval '(let [[:a] [1]] a))))
(is (thrown-with-cause-msg? Exception #"did not conform to spec"
(eval '(let [[:a/b] [1]] b)))))
(deftest namespaced-syms-only-allowed-in-map-destructuring
(is (thrown-with-cause-msg? Exception #"did not conform to spec"
(eval '(let [a/x 1, [y] [1]] x))))
(is (thrown-with-cause-msg? Exception #"did not conform to spec"
(eval '(let [[a/x] [1]] x)))))
(deftest or-doesnt-create-bindings
(is (thrown-with-cause-msg? Exception #"Unable to resolve symbol: b"
(eval '(let [{:keys [a] :or {b 2}} {:a 1}] [a b])))))
(require '[clojure.string :as s])
(deftest resolve-keyword-ns-alias-in-destructuring
(let [{:keys [::s/x ::s/y ::s/z] :or {z 3}} {:clojure.string/x 1 :clojure.string/y 2}]
(is (= [1 2 3] [x y z]))))
(deftest quote-with-multiple-args
(let [ex (is (thrown? clojure.lang.Compiler$CompilerException
(eval '(quote 1 2 3))))]
(is (= '(quote 1 2 3)
(-> ex
(.getCause)
(ex-data)
(:form))))))
(deftest typehints-retained-destructuring
(should-not-reflect
(defn foo
[{:keys [^String s]}]
(.indexOf s "boo"))))
clojure
(ns clojure.test-clojure.server
(:import java.util.Random)
(:require [clojure.test :refer :all])
(:require [clojure.core.server :as s]))
(deftest test-validate-opts
(check-invalid-opts {} "Missing required socket server property :name")
(check-invalid-opts {:name "a" :accept 'clojure.core/+} "Missing required socket server property :port")
(doseq [port [-1 "5" 999999]]
(check-invalid-opts {:name "a" :port port :accept 'clojure.core/+} (str "Invalid socket server port: " port)))
(check-invalid-opts {:name "a" :port 5555} "Missing required socket server property :accept"))
(deftest test-parse-props
(let [thread (create-random-thread)]
(.start thread)
(Thread/sleep 1000)
(try
(is (>= (count
(#'s/parse-props (System/getProperties))) 0))
(finally (.interrupt thread)))))
clojure
(ns clojure.test-clojure.sequences
(:require [clojure.test :refer :all]
[clojure.test.check.generators :as gen]
[clojure.test.check.properties :as prop]
[clojure.test.check.clojure-test :refer (defspec)])
(:import clojure.lang.IReduce))
(deftest test-reduce-from-chunked-into-unchunked
(is (= [1 2 \a \b] (into [] (concat [1 2] "ab")))))
(deftest test-reduce
(let [int+ (fn [a b] (+ (int a) (int b)))
arange (range 1 100) ;; enough to cross nodes
avec (into [] arange)
alist (into () arange)
obj-array (into-array arange)
int-array (into-array Integer/TYPE (map #(Integer. (int %)) arange))
long-array (into-array Long/TYPE arange)
float-array (into-array Float/TYPE arange)
char-array (into-array Character/TYPE (map char arange))
double-array (into-array Double/TYPE arange)
byte-array (into-array Byte/TYPE (map byte arange))
int-vec (into (vector-of :int) arange)
long-vec (into (vector-of :long) arange)
float-vec (into (vector-of :float) arange)
char-vec (into (vector-of :char) (map char arange))
double-vec (into (vector-of :double) arange)
byte-vec (into (vector-of :byte) (map byte arange))
all-true (into-array Boolean/TYPE (repeat 10 true))]
(is (== 4950
(reduce + arange)
(reduce + avec)
(.reduce ^IReduce avec +)
(reduce + alist)
(reduce + obj-array)
(reduce + int-array)
(reduce + long-array)
(reduce + float-array)
(reduce int+ char-array)
(reduce + double-array)
(reduce int+ byte-array)
(reduce + int-vec)
(reduce + long-vec)
(reduce + float-vec)
(reduce int+ char-vec)
(reduce + double-vec)
(reduce int+ byte-vec)))
(is (== 4951
(reduce + 1 arange)
(reduce + 1 avec)
(.reduce ^IReduce avec + 1)
(reduce + 1 alist)
(reduce + 1 obj-array)
(reduce + 1 int-array)
(reduce + 1 long-array)
(reduce + 1 float-array)
(reduce int+ 1 char-array)
(reduce + 1 double-array)
(reduce int+ 1 byte-array)
(reduce + 1 int-vec)
(reduce + 1 long-vec)
(reduce + 1 float-vec)
(reduce int+ 1 char-vec)
(reduce + 1 double-vec)
(reduce int+ 1 byte-vec)))
(is (= true
(reduce #(and %1 %2) all-true)
(reduce #(and %1 %2) true all-true)))))
(deftest test-into-IReduceInit
(let [iri (reify clojure.lang.IReduceInit
(reduce [_ f start]
(reduce f start (range 5))))]
(is (= [0 1 2 3 4] (into [] iri)))))
;; CLJ-1237 regression test
(deftest reduce-with-varying-impls
(is (= 1000000
(->> (repeat 500000 (cons 1 [1]))
(apply concat)
(reduce +))))
(deftest test-equality
; lazy sequences
(are [x y] (= x y)
; fixed SVN 1288 - LazySeq and EmptyList equals/equiv
; http://groups.google.com/group/clojure/browse_frm/thread/286d807be9cae2a5#
(map inc nil) ()
(map inc ()) ()
(map inc []) ()
(map inc #{}) ()
(map inc {}) ()
(sequence (map inc) (range 10)) (range 1 11)
(range 1 11) (sequence (map inc) (range 10))))
(deftest test-lazy-seq
(are [x] (seq? x)
(lazy-seq nil)
(lazy-seq [])
(lazy-seq [1 2]))
(deftest test-seq
(is (not (seq? (seq []))))
(is (seq? (seq [1 2])))
(is (not (.equals (seq [3]) (seq [3N]))))
(are [x y] (= x y)
(seq nil) nil
(seq [nil]) '(nil)
(deftest test-cons
(is (thrown? IllegalArgumentException (cons 1 2)))
(are [x y] (= x y)
(cons 1 nil) '(1)
(cons nil nil) '(nil)
(deftest test-empty
(are [x y] (and (= (empty x) y)
#_(= (class (empty x)) (class y)))
nil nil
;Tests that the comparator is preserved
;The first element should be the same in each set if preserved.
(deftest test-empty-sorted
(let [inv-compare (comp - compare)]
(are [x y] (= (first (into (empty x) x))
(first y))
(sorted-set 1 2 3) (sorted-set 1 2 3)
(sorted-set-by inv-compare 1 2 3) (sorted-set-by inv-compare 1 2 3)
(deftest test-not-empty
; empty coll/seq => nil
(are [x] (= (not-empty x) nil)
()
[]
{}
#{}
(seq ())
(seq [])
(lazy-seq ())
(lazy-seq []) )
(deftest test-first
;(is (thrown? Exception (first)))
(is (thrown? IllegalArgumentException (first true)))
(is (thrown? IllegalArgumentException (first false)))
(is (thrown? IllegalArgumentException (first 1)))
;(is (thrown? IllegalArgumentException (first 1 2)))
(is (thrown? IllegalArgumentException (first \a)))
(is (thrown? IllegalArgumentException (first 's)))
(is (thrown? IllegalArgumentException (first :k)))
(are [x y] (= x y)
(first nil) nil
(deftest test-next
; (is (thrown? IllegalArgumentException (next)))
(is (thrown? IllegalArgumentException (next true)))
(is (thrown? IllegalArgumentException (next false)))
(is (thrown? IllegalArgumentException (next 1)))
;(is (thrown? IllegalArgumentException (next 1 2)))
(is (thrown? IllegalArgumentException (next \a)))
(is (thrown? IllegalArgumentException (next 's)))
(is (thrown? IllegalArgumentException (next :k)))
(are [x y] (= x y)
(next nil) nil
(deftest test-last
(are [x y] (= x y)
(last nil) nil
;; (ffirst coll) = (first (first coll))
;;
(deftest test-ffirst
; (is (thrown? IllegalArgumentException (ffirst)))
(are [x y] (= x y)
(ffirst nil) nil
;; (fnext coll) = (first (next coll)) = (second coll)
;;
(deftest test-fnext
; (is (thrown? IllegalArgumentException (fnext)))
(are [x y] (= x y)
(fnext nil) nil
;; (nfirst coll) = (next (first coll))
;;
(deftest test-nfirst
; (is (thrown? IllegalArgumentException (nfirst)))
(are [x y] (= x y)
(nfirst nil) nil
;; (nnext coll) = (next (next coll))
;;
(deftest test-nnext
; (is (thrown? IllegalArgumentException (nnext)))
(are [x y] (= x y)
(nnext nil) nil
(deftest test-nth
; maps, sets are not supported
(is (thrown? UnsupportedOperationException (nth {} 0)))
(is (thrown? UnsupportedOperationException (nth {:a 1 :b 2} 0)))
(is (thrown? UnsupportedOperationException (nth #{} 0)))
(is (thrown? UnsupportedOperationException (nth #{1 2 3} 0)))
; distinct was broken for nil & false:
; fixed in rev 1278:
; http://code.google.com/p/clojure/source/detail?r=1278
;
(deftest test-distinct
(are [x y] (= x y)
(distinct ()) ()
(distinct '(1)) '(1)
(distinct '(1 2 3)) '(1 2 3)
(distinct '(1 2 3 1 1 1)) '(1 2 3)
(distinct '(1 1 1 2)) '(1 2)
(distinct '(1 2 1 2)) '(1 2)
(deftest test-interpose
(are [x y] (= x y)
(interpose 0 []) ()
(interpose 0 [1]) '(1)
(interpose 0 [1 2]) '(1 0 2)
(interpose 0 [1 2 3]) '(1 0 2 0 3) ))
(deftest test-interleave
(are [x y] (= x y)
(interleave [1 2] [3 4]) '(1 3 2 4)
(deftest test-zipmap
(are [x y] (= x y)
(zipmap [:a :b] [1 2]) {:a 1 :b 2}
(deftest test-concat
(are [x y] (= x y)
(concat) ()
(deftest test-cycle
(are [x y] (= x y)
(cycle []) ()
(deftest test-partition
(are [x y] (= x y)
(partition 2 [1 2 3]) '((1 2))
(partition 2 [1 2 3 4]) '((1 2) (3 4))
(partition 2 []) ()
(deftest test-partitionv
(are [x y] (= x y)
(partitionv 2 [1 2 3]) '((1 2))
(partitionv 2 [1 2 3 4]) '((1 2) (3 4))
(partitionv 2 []) ()
(deftest test-iterate
(are [x y] (= x y)
(take 0 (iterate inc 0)) ()
(take 1 (iterate inc 0)) '(0)
(take 2 (iterate inc 0)) '(0 1)
(take 5 (iterate inc 0)) '(0 1 2 3 4) )
(deftest test-reverse
(are [x y] (= x y)
(reverse nil) () ; since SVN 1294
(reverse []) ()
(reverse [1]) '(1)
(reverse [1 2 3]) '(3 2 1) ))
(deftest test-take
(are [x y] (= x y)
(take 1 [1 2 3 4 5]) '(1)
(take 3 [1 2 3 4 5]) '(1 2 3)
(take 5 [1 2 3 4 5]) '(1 2 3 4 5)
(take 9 [1 2 3 4 5]) '(1 2 3 4 5)
(deftest test-drop
(are [x y] (= x y)
(drop 1 [1 2 3 4 5]) '(2 3 4 5)
(drop 3 [1 2 3 4 5]) '(4 5)
(drop 5 [1 2 3 4 5]) ()
(drop 9 [1 2 3 4 5]) ()
(deftest test-nthrest
(are [x y] (= x y)
(nthrest [1 2 3 4 5] 1) '(2 3 4 5)
(nthrest [1 2 3 4 5] 3) '(4 5)
(nthrest [1 2 3 4 5] 5) ()
(nthrest [1 2 3 4 5] 9) ()
(deftest test-nthnext
(are [x y] (= x y)
(nthnext [1 2 3 4 5] 1) '(2 3 4 5)
(nthnext [1 2 3 4 5] 3) '(4 5)
(nthnext [1 2 3 4 5] 5) nil
(nthnext [1 2 3 4 5] 9) nil
(deftest test-take-nth
(are [x y] (= x y)
(take-nth 1 [1 2 3 4 5]) '(1 2 3 4 5)
(take-nth 2 [1 2 3 4 5]) '(1 3 5)
(take-nth 3 [1 2 3 4 5]) '(1 4)
(take-nth 4 [1 2 3 4 5]) '(1 5)
(take-nth 5 [1 2 3 4 5]) '(1)
(take-nth 9 [1 2 3 4 5]) '(1)
(deftest test-take-while
(are [x y] (= x y)
(take-while pos? []) ()
(take-while pos? [1 2 3 4]) '(1 2 3 4)
(take-while pos? [1 2 3 -1]) '(1 2 3)
(take-while pos? [1 -1 2 3]) '(1)
(take-while pos? [-1 1 2 3]) ()
(take-while pos? [-1 -2 -3]) () ))
(deftest test-drop-while
(are [x y] (= x y)
(drop-while pos? []) ()
(drop-while pos? [1 2 3 4]) ()
(drop-while pos? [1 2 3 -1]) '(-1)
(drop-while pos? [1 -1 2 3]) '(-1 2 3)
(drop-while pos? [-1 1 2 3]) '(-1 1 2 3)
(drop-while pos? [-1 -2 -3]) '(-1 -2 -3) ))
(deftest test-butlast
(are [x y] (= x y)
(butlast []) nil
(butlast [1]) nil
(butlast [1 2 3]) '(1 2) ))
(deftest test-drop-last
(are [x y] (= x y)
; as butlast
(drop-last []) ()
(drop-last [1]) ()
(drop-last [1 2 3]) '(1 2)
(deftest test-split-at
(is (vector? (split-at 2 [])))
(is (vector? (split-at 2 [1 2 3])))
(deftest test-split-with
(is (vector? (split-with pos? [])))
(is (vector? (split-with pos? [1 2 -1 0 3 4])))
(deftest test-repeat
;(is (thrown? IllegalArgumentException (repeat)))
(deftest test-range
(are [x y] (= x y)
(take 100 (range)) (range 100)
(deftest range-meta
(are [r] (= r (with-meta r {:a 1}))
(range 10)
(range 5 10)
(range 5 10 1)
(range 10.0)
(range 5.0 10.0)
(range 5.0 10.0 1.0)))
(deftest range-test
(let [threads 10
n 1000
r (atom (range (inc n)))
m (atom 0)]
; Iterate through the range concurrently,
; updating m to the highest seen value in the range
(->> (range threads)
(map (fn [id]
(future
(loop []
(when-let [r (swap! r next)]
(swap! m max (first r))
(recur))))))
(map deref)
dorun)
(is (= n @m))))
(deftest test-longrange-corners
(let [lmax Long/MAX_VALUE
lmax-1 (- Long/MAX_VALUE 1)
lmax-2 (- Long/MAX_VALUE 2)
lmax-31 (- Long/MAX_VALUE 31)
lmax-32 (- Long/MAX_VALUE 32)
lmax-33 (- Long/MAX_VALUE 33)
lmin Long/MIN_VALUE
lmin+1 (+ Long/MIN_VALUE 1)
lmin+2 (+ Long/MIN_VALUE 2)
lmin+31 (+ Long/MIN_VALUE 31)
lmin+32 (+ Long/MIN_VALUE 32)
lmin+33 (+ Long/MIN_VALUE 33)]
(doseq [range-args [ [lmax-2 lmax]
[lmax-33 lmax]
[lmax-33 lmax-31]
[lmin+2 lmin -1]
[lmin+33 lmin -1]
[lmin+33 lmin+31 -1]
[lmin lmax lmax]
[lmax lmin lmin]
[-1 lmax lmax]
[1 lmin lmin]]]
(is (= (apply unlimited-range-create range-args)
(apply range range-args))
(apply str "from (range " (concat (interpose " " range-args) ")"))))))
(deftest test-empty?
(are [x] (empty? x)
nil
()
(lazy-seq nil) ; => ()
[]
{}
#{}
""
(into-array [])
(transient [])
(transient #{})
(transient {}))
(deftest test-every?
; always true for nil or empty coll/seq
(are [x] (= (every? pos? x) true)
nil
() [] {} #{}
(lazy-seq [])
(into-array []) )
(deftest test-not-every?
; always false for nil or empty coll/seq
(are [x] (= (not-every? pos? x) false)
nil
() [] {} #{}
(lazy-seq [])
(into-array []) )
(deftest test-not-any?
; always true for nil or empty coll/seq
(are [x] (= (not-any? pos? x) true)
nil
() [] {} #{}
(lazy-seq [])
(into-array []) )
(deftest test-some
;; always nil for nil or empty coll/seq
(are [x] (= (some pos? x) nil)
nil
() [] {} #{}
(lazy-seq [])
(into-array []))
(are [x y] (= x y)
nil (some nil nil)
true (some pos? [1])
true (some pos? [1 2])
nil (some pos? [-1])
nil (some pos? [-1 -2])
true (some pos? [-1 2])
true (some pos? [1 -2])
:a (some #{:a} [:a :a])
:a (some #{:a} [:b :a])
nil (some #{:a} [:b :b])
:a (some #{:a} '(:a :b))
:a (some #{:a} #{:a :b})
))
(deftest test-flatten-present
(are [expected nested-val] (= (flatten nested-val) expected)
;simple literals
[] nil
[] 1
[] 'test
[] :keyword
[] 1/2
[] #"[\r\n]"
[] true
[] false
;vectors
[1 2 3 4 5] [[1 2] [3 4 [5]]]
[1 2 3 4 5] [1 2 3 4 5]
[#{1 2} 3 4 5] [#{1 2} 3 4 5]
;sets
[] #{}
[] #{#{1 2} 3 4 5}
[] #{1 2 3 4 5}
[] #{#{1 2} 3 4 5}
;lists
[] '()
[1 2 3 4 5] `(1 2 3 4 5)
;maps
[] {:a 1 :b 2}
[:a 1 :b 2] (sort-by key {:a 1 :b 2})
[] {[:a :b] 1 :c 2}
[:a :b 1 :c 2] (sort-by val {[:a :b] 1 :c 2})
[:a 1 2 :b 3] (sort-by key {:a [1 2] :b 3})
;Strings
[] "12345"
[\1 \2 \3 \4 \5] (seq "12345")
;fns
[] count
[count even? odd?] [count even? odd?]))
(deftest test-group-by
(is (= (group-by even? [1 2 3 4 5])
{false [1 3 5], true [2 4]})))
(deftest test-partition-by
(are [test-seq] (= (partition-by (comp even? count) test-seq)
[["a"] ["bb" "cccc" "dd"] ["eee" "f"] ["" "hh"]])
["a" "bb" "cccc" "dd" "eee" "f" "" "hh"]
'("a" "bb" "cccc" "dd" "eee" "f" "" "hh"))
(is (=(partition-by #{\a \e \i \o \u} "abcdefghijklm")
[[\a] [\b \c \d] [\e] [\f \g \h] [\i] [\j \k \l \m]]))
;; CLJ-1764 regression test
(is (=(first (second (partition-by zero? (range))))
1)))
(deftest test-frequencies
(are [expected test-seq] (= (frequencies test-seq) expected)
{\p 2, \s 4, \i 4, \m 1} "mississippi"
{1 4 2 2 3 1} [1 1 1 1 2 2 3]
{1 4 2 2 3 1} '(1 1 1 1 2 2 3)))
(deftest test-reductions
(is (= (reductions + nil)
[0]))
(is (= (reductions + [1 2 3 4 5])
[1 3 6 10 15]))
(is (= (reductions + 10 [1 2 3 4 5])
[10 11 13 16 20 25])))
(deftest test-reductions-obeys-reduced
(is (= [0 :x]
(reductions (constantly (reduced :x))
(range))))
(is (= [:x]
(reductions (fn [acc x] x)
(reduced :x)
(range))))
(is (= [2 6 12 12]
(reductions (fn [acc x]
(if (= x :stop)
(reduced acc)
(+ acc x)))
[2 4 6 :stop 8 10]))))
(deftest test-rand-nth-invariants
(let [elt (rand-nth [:a :b :c :d])]
(is (#{:a :b :c :d} elt))))
(deftest test-partition-all
(is (= (partition-all 4 [1 2 3 4 5 6 7 8 9])
[[1 2 3 4] [5 6 7 8] [9]]))
(is (= (partition-all 4 2 [1 2 3 4 5 6 7 8 9])
[[1 2 3 4] [3 4 5 6] [5 6 7 8] [7 8 9] [9]])))
(deftest test-partitionv-all
(is (= (partitionv-all 4 [1 2 3 4 5 6 7 8 9])
[[1 2 3 4] [5 6 7 8] [9]]))
(is (= (partitionv-all 4 2 [1 2 3 4 5 6 7 8 9])
[[1 2 3 4] [3 4 5 6] [5 6 7 8] [7 8 9] [9]])))
(deftest test-shuffle-invariants
(is (= (count (shuffle [1 2 3 4])) 4))
(let [shuffled-seq (shuffle [1 2 3 4])]
(is (every? #{1 2 3 4} shuffled-seq))))
(deftest test-ArrayIter
(are [arr expected]
(let [iter (clojure.lang.ArrayIter/createFromObject arr)]
(loop [accum []]
(if (.hasNext iter)
(recur (conj accum (.next iter)))
(is (= expected accum)))))
nil []
(object-array ["a" "b" "c"]) ["a" "b" "c"]
(boolean-array [false true false]) [false true false]
(byte-array [1 2]) [(byte 1) (byte 2)]
(short-array [1 2]) [1 2]
(int-array [1 2]) [1 2]
(long-array [1 2]) [1 2]
(float-array [2.0 -2.5]) [2.0 -2.5]
(double-array [1.2 -3.5]) [1.2 -3.5]
(char-array [\H \i]) [\H \i]))
(deftest CLJ-1633
(is (= ((fn [& args] (apply (fn [a & b] (apply list b)) args)) 1 2 3) '(2 3))))
(deftest test-subseq
(let [s1 (range 100)
s2 (into (sorted-set) s1)]
(is (= s1 (seq s2)))
(doseq [i (range 100)]
(is (= s1 (concat (subseq s2 < i) (subseq s2 >= i))))
(is (= (reverse s1) (concat (rsubseq s2 >= i) (rsubseq s2 < i)))))))
(deftest test-sort-retains-meta
(is (= {:a true} (meta (sort (with-meta (range 10) {:a true})))))
(is (= {:a true} (meta (sort-by :a (with-meta (seq [{:a 5} {:a 2} {:a 3}]) {:a true}))))))
(deftest test-seqs-implements-iobj
(doseq [coll [[1 2 3]
(vector-of :long 1 2 3)
{:a 1 :b 2 :c 3}
(sorted-map :a 1 :b 2 :c 3)
#{1 2 3}
(sorted-set 1 2 3)
(into clojure.lang.PersistentQueue/EMPTY [1 2 3])]]
(is (= true (instance? clojure.lang.IMeta coll)))
(is (= {:a true} (meta (with-meta coll {:a true}))))
(is (= true (instance? clojure.lang.IMeta (seq coll))))
(is (= {:a true} (meta (with-meta (seq coll) {:a true}))))
(when (reversible? coll)
(is (= true (instance? clojure.lang.IMeta (rseq coll))))
(is (= {:a true} (meta (with-meta (rseq coll) {:a true})))))))
(deftest test-iteration-opts
(let [genstep (fn [steps]
(fn [k] (swap! steps inc) (inc k)))
test (fn [expect & iteropts]
(is (= expect
(let [nsteps (atom 0)
iter (apply iteration (genstep nsteps) iteropts)
ret (doall (seq iter))]
{:ret ret :steps @nsteps})
(let [nsteps (atom 0)
iter (apply iteration (genstep nsteps) iteropts)
ret (into [] iter)]
{:ret ret :steps @nsteps}))))]
(test {:ret [1 2 3 4]
:steps 5}
:initk 0 :somef #(< % 5))
(test {:ret [1 2 3 4 5]
:steps 5}
:initk 0 :kf (fn [ret] (when (< ret 5) ret)))
(test {:ret ["1"]
:steps 2}
:initk 0 :somef #(< % 2) :vf str))
(deftest test-iteration
;; equivalence to line-seq
(let [readme #(java.nio.file.Files/newBufferedReader (.toPath (java.io.File. "readme.txt")))]
(is (= (with-open [r (readme)]
(vec (iteration (fn [_] (.readLine r)))))
(with-open [r (readme)]
(doall (line-seq r))))))
(deftest test-reduce-on-coll-seqs
;; reduce on seq of coll, both with and without an init
(are [coll expected expected-init]
(and
(= expected-init (reduce conj [:init] (seq coll)))
(= expected (reduce conj (seq coll))))
;; (seq [ ... ])
[] [] [:init]
[1] 1 [:init 1]
[[1] 2] [1 2] [:init [1] 2]
clojure
(ns clojure.test-clojure.run-single-test
(:require [clojure.test :refer [is deftest run-test run-tests]]
[clojure.test-helper :refer [with-err-string-writer]]
[clojure.test-clojure.test-fixtures :as tf]))
(deftest reports-missing-var
(should-print-to-err #"^Unable to resolve .*/function-missing to a test function.*"
(let [result (eval `(run-test function-missing))]
(is (nil? result)))))
(deftest reports-non-test-var
(should-print-to-err #"^.*/not-a-test is not a test.*"
(let [result (eval `(run-test not-a-test))]
(is (nil? result)))))
(deftest can-run-test-with-fixtures
(is (= {:test 1, :pass 2, :fail 0, :error 0, :type :summary}
(run-test tf/can-use-once-fixtures))))
clojure
(ns clojure.test-clojure.rt
(:require [clojure.string :as string]
clojure.set)
(:use clojure.test clojure.test-helper))
(deftest rt-print-prior-to-print-initialize
(testing "pattern literals"
(is (= "#\"foo\"" (bare-rt-print #"foo")))))
(deftest error-messages
(testing "binding a core var that already refers to something"
(should-print-err-message
#"WARNING: prefers already refers to: #'clojure.core/prefers in namespace: .*\r?\n"
(defn prefers [] (throw (RuntimeException. "rebound!")))))
(testing "reflection cannot resolve field"
(should-print-err-message
#"Reflection warning, .*:\d+:\d+ - reference to field blah can't be resolved\.\r?\n"
(defn foo [x] (.blah x))))
(testing "reflection cannot resolve field on known class"
(should-print-err-message
#"Reflection warning, .*:\d+:\d+ - reference to field blah on java\.lang\.String can't be resolved\.\r?\n"
(defn foo [^String x] (.blah x))))
(testing "reflection cannot resolve instance method because it is missing"
(should-print-err-message
#"Reflection warning, .*:\d+:\d+ - call to method zap on java\.lang\.String can't be resolved \(no such method\)\.\r?\n"
(defn foo [^String x] (.zap x 1))))
(testing "reflection cannot resolve instance method because it has incompatible argument types"
(should-print-err-message
#"Reflection warning, .*:\d+:\d+ - call to method getBytes on java\.lang\.String can't be resolved \(argument types: java\.util\.regex\.Pattern\)\.\r?\n"
(defn foo [^String x] (.getBytes x #"boom"))))
(testing "reflection cannot resolve instance method because it has unknown argument types"
(should-print-err-message
#"Reflection warning, .*:\d+:\d+ - call to method getBytes on java\.lang\.String can't be resolved \(argument types: unknown\)\.\r?\n"
(defn foo [^String x y] (.getBytes x y))))
(testing "reflection error prints correctly for nil arguments"
(should-print-err-message
#"Reflection warning, .*:\d+:\d+ - call to method divide on java\.math\.BigDecimal can't be resolved \(argument types: unknown, unknown\)\.\r?\n"
(defn foo [a] (.divide 1M a nil))))
(testing "reflection cannot resolve instance method because target class is unknown"
(should-print-err-message
#"Reflection warning, .*:\d+:\d+ - call to method zap can't be resolved \(target class is unknown\)\.\r?\n"
(defn foo [x] (.zap x 1))))
(testing "reflection cannot resolve static method"
(should-print-err-message
#"Reflection warning, .*:\d+:\d+ - call to static method valueOf on java\.lang\.Integer can't be resolved \(argument types: java\.util\.regex\.Pattern\)\.\r?\n"
(defn foo [] (Integer/valueOf #"boom"))))
(testing "reflection cannot resolve constructor"
(should-print-err-message
#"Reflection warning, .*:\d+:\d+ - call to java\.lang\.String ctor can't be resolved\.\r?\n"
(defn foo [] (String. 1 2 3)))))
(def example-var)
(deftest binding-root-clears-macro-metadata
(alter-meta! #'example-var assoc :macro true)
(is (contains? (meta #'example-var) :macro))
(.bindRoot #'example-var 0)
(is (not (contains? (meta #'example-var) :macro))))
(deftest ns-intern-policies
(testing "you can replace a core name, with warning"
(let [ns (temp-ns)
replacement (gensym)
e1 (with-err-string-writer (intern ns 'prefers replacement))]
(is (string/starts-with? e1 "WARNING"))
(is (= replacement @('prefers (ns-publics ns))))))
(testing "you can replace a defined alias"
(let [ns (temp-ns)
s (gensym)
v1 (intern ns 'foo s)
v2 (intern ns 'bar s)
e1 (with-err-string-writer (.refer ns 'flatten v1))
e2 (with-err-string-writer (.refer ns 'flatten v2))]
(is (string/starts-with? e1 "WARNING"))
(is (string/starts-with? e2 "WARNING"))
(is (= v2 (ns-resolve ns 'flatten)))))
(testing "you cannot replace an interned var"
(let [ns1 (temp-ns)
ns2 (temp-ns)
v1 (intern ns1 'foo 1)
v2 (intern ns2 'foo 2)
e1 (with-err-string-writer (.refer ns1 'foo v2))]
(is (string/starts-with? e1 "REJECTED"))
(is (= v1 (ns-resolve ns1 'foo))))))
clojure
(ns clojure.test-clojure.reducers
(:require [clojure.core.reducers :as r]
[clojure.test.generative :refer (defspec)]
[clojure.data.generators :as gen])
(:use clojure.test))
(defmacro defequivtest
;; f is the core fn, r is the reducers equivalent, rt is the reducible ->
;; coll transformer
[name [f r rt] fns]
`(deftest ~name
(let [c# (range -100 1000)]
(doseq [fn# ~fns]
(is (= (~f fn# c#)
(~rt (~r fn# c#))))))))
(deftest test-mapcat-obeys-reduced
(is (= [1 "0" 2 "1" 3]
(->> (concat (range 100) (lazy-seq (throw (Exception. "Too eager"))))
(r/mapcat (juxt inc str))
(r/take 5)
(into [])))))
(deftest test-sorted-maps
(let [m (into (sorted-map)
'{1 a, 2 b, 3 c, 4 d})]
(is (= "1a2b3c4d" (reduce-kv str "" m))
"Sorted maps should reduce-kv in sorted order")
(is (= 1 (reduce-kv (fn [acc k v]
(reduced (+ acc k)))
0 m))
"Sorted maps should stop reduction when asked")))
(deftest test-nil
(is (= {:k :v} (reduce-kv assoc {:k :v} nil)))
(is (= 0 (r/fold + nil))))
(deftest test-fold-runtime-exception
(is (thrown? IndexOutOfBoundsException
(let [test-map-count 1234
k-fail (rand-int test-map-count)]
(r/fold (fn ([])
([ret [k v]])
([ret k v] (when (= k k-fail)
(throw (IndexOutOfBoundsException.)))))
(zipmap (range test-map-count) (repeat :dummy)))))))
(deftest test-closed-over-clearing
;; this will throw OutOfMemory without proper reference clearing
(is (number? (reduce + 0 (r/map identity (range 1e8))))))
clojure
(ns clojure.test-clojure.reader
(:use clojure.test)
(:use [clojure.instant :only [read-instant-date
read-instant-calendar
read-instant-timestamp]])
(:require clojure.walk
[clojure.edn :as edn]
[clojure.test.generative :refer (defspec)]
[clojure.test-clojure.generators :as cgen]
[clojure.edn :as edn])
(:import [clojure.lang BigInt Ratio]
java.io.File
java.util.TimeZone))
(deftest Symbols
(is (= 'abc (symbol "abc")))
(is (= '*+!-_? (symbol "*+!-_?")))
(is (= 'abc:def:ghi (symbol "abc:def:ghi")))
(is (= 'abc/def (symbol "abc" "def")))
(is (= 'abc.def/ghi (symbol "abc.def" "ghi")))
(is (= 'abc/def.ghi (symbol "abc" "def.ghi")))
(is (= 'abc:def/ghi:jkl.mno (symbol "abc:def" "ghi:jkl.mno")))
(is (instance? clojure.lang.Symbol 'alphabet))
)
(deftest Literals
; 'nil 'false 'true are reserved by Clojure and are not symbols
(is (= 'nil nil))
(is (= 'false false))
(is (= 'true true)) )
(deftest Strings
(is (= "abcde" (str \a \b \c \d \e)))
(is (= "abc
def" (str \a \b \c \newline \space \space \d \e \f)))
(let [f (temp-file "clojure.core-reader" "test")]
(doseq [source [:string :file]]
(testing (str "Valid string literals read from " (name source))
(are [x form] (= x (code-units
(read-from source f (str "\"" form "\""))))
[] ""
[34] "\\\""
[10] "\\n"
(deftest Numbers
(deftest t-Characters
(let [f (temp-file "clojure.core-reader" "test")]
(doseq [source [:string :file]]
(testing (str "Valid char literals read from " (name source))
(are [x form] (= x (read-from source f form))
(first "o") "\\o"
(char 0) "\\o0"
(char 0) "\\o000"
(char 047) "\\o47"
(char 0377) "\\o377"
(deftest t-nil)
(deftest t-Booleans)
(deftest t-Keywords
(is (= :abc (keyword "abc")))
(is (= :abc (keyword 'abc)))
(is (= :*+!-_? (keyword "*+!-_?")))
(is (= :abc:def:ghi (keyword "abc:def:ghi")))
(is (= :abc/def (keyword "abc" "def")))
(is (= :abc/def (keyword 'abc/def)))
(is (= :abc.def/ghi (keyword "abc.def" "ghi")))
(is (= :abc/def.ghi (keyword "abc" "def.ghi")))
(is (= :abc:def/ghi:jkl.mno (keyword "abc:def" "ghi:jkl.mno")))
(is (instance? clojure.lang.Keyword :alphabet))
)
(deftest reading-keywords
(are [x y] (= x (binding [*ns* (the-ns 'user)] (read-string y)))
:foo ":foo"
:foo/bar ":foo/bar"
:user/foo "::foo")
(are [err msg form] (thrown-with-msg? err msg (read-string form))
Exception #"Invalid token: foo:" "foo:"
Exception #"Invalid token: :bar/" ":bar/"
Exception #"Invalid token: ::does.not/exist" "::does.not/exist"))
;; Lists
(deftest t-Lists)
(deftest t-Vectors)
(deftest t-Maps)
(deftest t-Sets)
(deftest t-Quote)
(deftest t-Character)
(deftest t-Comment)
(deftest t-Deref)
(deftest t-Regex)
(deftest t-line-column-numbers
(let [code "(ns reader-metadata-test
(:require [clojure.java.io
:refer (resource reader)]))
(deftest set-line-number
(let [r (clojure.lang.LineNumberingPushbackReader. *in*)]
(.setLineNumber r 100)
(is (= 100 (.getLineNumber r)))))
(deftest t-Metadata
(is (= (meta '^:static ^:awesome ^{:static false :bar :baz} sym) {:awesome true, :bar :baz, :static true})))
(deftest t-Var-quote)
(deftest t-Anonymouns-function-literal)
(deftest t-Syntax-quote
(are [x y] (= x y)
`() () ; was NPE before SVN r1337
))
(deftest t-read)
(deftest division
(is (= clojure.core// /))
(binding [*ns* *ns*]
(eval '(do (ns foo
(:require [clojure.core :as bar])
(:use [clojure.test]))
(is (= clojure.core// bar//))))))
(deftest Instants
(testing "Instants are read as java.util.Date by default"
(is (= java.util.Date (class #inst "2010-11-12T13:14:15.666"))))
(let [s "#inst \"2010-11-12T13:14:15.666-06:00\""]
(binding [*data-readers* {'inst read-instant-date}]
(testing "read-instant-date produces java.util.Date"
(is (= java.util.Date (class (read-string s)))))
(testing "java.util.Date instants round-trips"
(is (= (-> s read-string)
(-> s read-string pr-str read-string))))
(testing "java.util.Date instants round-trip throughout the year"
(doseq [month (range 1 13) day (range 1 29) hour (range 1 23)]
(let [s (format "#inst \"2010-%02d-%02dT%02d:14:15.666-06:00\"" month day hour)]
(is (= (-> s read-string)
(-> s read-string pr-str read-string))))))
(testing "java.util.Date handling DST in time zones"
(let [dtz (TimeZone/getDefault)]
(try
;; A timezone with DST in effect during 2010-11-12
(TimeZone/setDefault (TimeZone/getTimeZone "Australia/Sydney"))
(is (= (-> s read-string)
(-> s read-string pr-str read-string)))
(finally (TimeZone/setDefault dtz)))))
(testing "java.util.Date should always print in UTC"
(let [d (read-string s)
pstr (print-str d)
len (.length pstr)]
(is (= (subs pstr (- len 7)) "-00:00\"")))))
(binding [*data-readers* {'inst read-instant-calendar}]
(testing "read-instant-calendar produces java.util.Calendar"
(is (instance? java.util.Calendar (read-string s))))
(testing "java.util.Calendar round-trips"
(is (= (-> s read-string)
(-> s read-string pr-str read-string))))
(testing "java.util.Calendar remembers timezone in literal"
(is (= "#inst \"2010-11-12T13:14:15.666-06:00\""
(-> s read-string pr-str)))
(is (= (-> s read-string)
(-> s read-string pr-str read-string))))
(testing "java.util.Calendar preserves milliseconds"
(is (= 666 (-> s read-string
(.get java.util.Calendar/MILLISECOND)))))))
(let [s "#inst \"2010-11-12T13:14:15.123456789\""
s2 "#inst \"2010-11-12T13:14:15.123\""
s3 "#inst \"2010-11-12T13:14:15.123456789123\""]
(binding [*data-readers* {'inst read-instant-timestamp}]
(testing "read-instant-timestamp produces java.sql.Timestamp"
(is (= java.sql.Timestamp (class (read-string s)))))
(testing "java.sql.Timestamp preserves nanoseconds"
(is (= 123456789 (-> s read-string .getNanos)))
(is (= 123456789 (-> s read-string pr-str read-string .getNanos)))
;; truncate at nanos for s3
(is (= 123456789 (-> s3 read-string pr-str read-string .getNanos))))
(testing "java.sql.Timestamp should compare nanos"
(is (= (read-string s) (read-string s3)))
(is (not= (read-string s) (read-string s2)))))
(binding [*data-readers* {'inst read-instant-date}]
(testing "read-instant-date should truncate at milliseconds"
(is (= (read-string s) (read-string s2) (read-string s3))))))
(let [s "#inst \"2010-11-12T03:14:15.123+05:00\""
s2 "#inst \"2010-11-11T22:14:15.123Z\""]
(binding [*data-readers* {'inst read-instant-date}]
(testing "read-instant-date should convert to UTC"
(is (= (read-string s) (read-string s2)))))
(binding [*data-readers* {'inst read-instant-timestamp}]
(testing "read-instant-timestamp should convert to UTC"
(is (= (read-string s) (read-string s2)))))
(binding [*data-readers* {'inst read-instant-calendar}]
(testing "read-instant-calendar should preserve timezone"
(is (not= (read-string s) (read-string s2)))))))
(deftest UUID
(is (= java.util.UUID (class #uuid "550e8400-e29b-41d4-a716-446655440000")))
(is (.equals #uuid "550e8400-e29b-41d4-a716-446655440000"
#uuid "550e8400-e29b-41d4-a716-446655440000"))
(is (not (identical? #uuid "550e8400-e29b-41d4-a716-446655440000"
#uuid "550e8400-e29b-41d4-a716-446655440000")))
(is (= 4 (.version #uuid "550e8400-e29b-41d4-a716-446655440000")))
(is (= (print-str #uuid "550e8400-e29b-41d4-a716-446655440000")
"#uuid \"550e8400-e29b-41d4-a716-446655440000\"")))
(deftest unknown-tag
(let [my-unknown (fn [tag val] {:unknown-tag tag :value val})
throw-on-unknown (fn [tag val] (throw (RuntimeException. (str "No data reader function for tag " tag))))
my-uuid (partial my-unknown 'uuid)
u "#uuid \"550e8400-e29b-41d4-a716-446655440000\""
s "#never.heard.of/some-tag [1 2]" ]
(binding [*data-readers* {'uuid my-uuid}
*default-data-reader-fn* my-unknown]
(testing "Unknown tag"
(is (= (read-string s)
{:unknown-tag 'never.heard.of/some-tag
:value [1 2]})))
(testing "Override uuid tag"
(is (= (read-string u)
{:unknown-tag 'uuid
:value "550e8400-e29b-41d4-a716-446655440000"}))))
(deftest preserve-read-cond-test
(let [x (read-string {:read-cond :preserve} "#?(:clj foo :cljs bar)" )]
(is (reader-conditional? x))
(is (not (:splicing? x)))
(is (= :foo (get x :no-such-key :foo)))
(is (= (:form x) '(:clj foo :cljs bar)))
(is (= x (reader-conditional '(:clj foo :cljs bar) false))))
(let [x (read-string {:read-cond :preserve} "#?@(:clj [foo])" )]
(is (reader-conditional? x))
(is (:splicing? x))
(is (= :foo (get x :no-such-key :foo)))
(is (= (:form x) '(:clj [foo])))
(is (= x (reader-conditional '(:clj [foo]) true))))
(is (thrown-with-msg? RuntimeException #"No reader function for tag"
(read-string {:read-cond :preserve} "#js {:x 1 :y 2}" )))
(let [x (read-string {:read-cond :preserve} "#?(:cljs #js {:x 1 :y 2})")
[platform tl] (:form x)]
(is (reader-conditional? x))
(is (tagged-literal? tl))
(is (= 'js (:tag tl)))
(is (= {:x 1 :y 2} (:form tl)))
(is (= :foo (get tl :no-such-key :foo)))
(is (= tl (tagged-literal 'js {:x 1 :y 2}))))
(testing "print form roundtrips"
(doseq [s ["#?(:clj foo :cljs bar)"
"#?(:cljs #js {:x 1, :y 2})"
"#?(:clj #clojure.test_clojure.reader.TestRecord [42 85])"]]
(is (= s (pr-str (read-string {:read-cond :preserve} s)))))))
(deftest reader-conditionals
(testing "basic read-cond"
(is (= '[foo-form]
(read-string {:read-cond :allow :features #{:foo}} "[#?(:foo foo-form :bar bar-form)]")))
(is (= '[bar-form]
(read-string {:read-cond :allow :features #{:bar}} "[#?(:foo foo-form :bar bar-form)]")))
(is (= '[foo-form]
(read-string {:read-cond :allow :features #{:foo :bar}} "[#?(:foo foo-form :bar bar-form)]")))
(is (= '[]
(read-string {:read-cond :allow :features #{:baz}} "[#?( :foo foo-form :bar bar-form)]"))))
(testing "environmental features"
(is (= "clojure" #?(:clj "clojure" :cljs "clojurescript" :default "default"))))
(testing "default features"
(is (= "default" #?(:clj-clr "clr" :cljs "cljs" :default "default"))))
(testing "splicing"
(is (= [] [#?@(:clj [])]))
(is (= [:a] [#?@(:clj [:a])]))
(is (= [:a :b] [#?@(:clj [:a :b])]))
(is (= [:a :b :c] [#?@(:clj [:a :b :c])]))
(is (= [:a :b :c] [#?@(:clj [:a :b :c])])))
(testing "nested splicing"
(is (= [:a :b :c :d :e]
[#?@(:clj [:a #?@(:clj [:b #?@(:clj [:c]) :d]):e])]))
(is (= '(+ 1 (+ 2 3))
'(+ #?@(:clj [1 (+ #?@(:clj [2 3]))]))))
(is (= '(+ (+ 2 3) 1)
'(+ #?@(:clj [(+ #?@(:clj [2 3])) 1]))))
(is (= [:a [:b [:c] :d] :e]
[#?@(:clj [:a [#?@(:clj [:b #?@(:clj [[:c]]) :d])] :e])])))
(testing "bypass unknown tagged literals"
(is (= [1 2 3] #?(:cljs #js [1 2 3] :clj [1 2 3])))
(is (= :clojure #?(:foo #some.nonexistent.Record {:x 1} :clj :clojure))))
(testing "error cases"
(is (thrown-with-msg? RuntimeException #"Feature should be a keyword" (read-string {:read-cond :allow} "#?((+ 1 2) :a)")))
(is (thrown-with-msg? RuntimeException #"even number of forms" (read-string {:read-cond :allow} "#?(:cljs :a :clj)")))
(is (thrown-with-msg? RuntimeException #"read-cond-splicing must implement" (read-string {:read-cond :allow} "#?@(:clj :a)")))
(is (thrown-with-msg? RuntimeException #"is reserved" (read-string {:read-cond :allow} "#?@(:foo :a :else :b)")))
(is (thrown-with-msg? RuntimeException #"must be a list" (read-string {:read-cond :allow} "#?[:foo :a :else :b]")))
(is (thrown-with-msg? RuntimeException #"Conditional read not allowed" (read-string {:read-cond :BOGUS} "#?[:clj :a :default nil]")))
(is (thrown-with-msg? RuntimeException #"Conditional read not allowed" (read-string "#?[:clj :a :default nil]")))
(is (thrown-with-msg? RuntimeException #"Reader conditional splicing not allowed at the top level" (read-string {:read-cond :allow} "#?@(:clj [1 2])")))
(is (thrown-with-msg? RuntimeException #"Reader conditional splicing not allowed at the top level" (read-string {:read-cond :allow} "#?@(:clj [1])")))
(is (thrown-with-msg? RuntimeException #"Reader conditional splicing not allowed at the top level" (read-string {:read-cond :allow} "#?@(:clj []) 1"))))
(testing "clj-1698-regression"
(let [opts {:features #{:clj} :read-cond :allow}]
(is (= 1 (read-string opts "#?(:cljs {'a 1 'b 2} :clj 1)")))
(is (= 1 (read-string opts "#?(:cljs (let [{{b :b} :a {d :d} :c} {}]) :clj 1)")))
(is (= '(def m {}) (read-string opts "(def m #?(:cljs ^{:a :b} {} :clj ^{:a :b} {}))")))
(is (= '(def m {}) (read-string opts "(def m #?(:cljs ^{:a :b} {} :clj ^{:a :b} {}))")))
(is (= 1 (read-string opts "#?(:cljs {:a #_:b :c} :clj 1)")))))
(testing "nil expressions"
(is (nil? #?(:default nil)))
(is (nil? #?(:foo :bar :clj nil)))
(is (nil? #?(:clj nil :foo :bar)))
(is (nil? #?(:foo :bar :default nil)))))
(deftest eof-option
(is (= 23 (read-string {:eof 23} "")))
(is (= 23 (read {:eof 23} (clojure.lang.LineNumberingPushbackReader.
(java.io.StringReader. ""))))))
(require '[clojure.string :as s])
(deftest namespaced-maps
(is (= #:a{1 nil, :b nil, :b/c nil, :_/d nil}
#:a {1 nil, :b nil, :b/c nil, :_/d nil}
{1 nil, :a/b nil, :b/c nil, :d nil}))
(is (= #::{1 nil, :a nil, :a/b nil, :_/d nil}
#:: {1 nil, :a nil, :a/b nil, :_/d nil}
{1 nil, :clojure.test-clojure.reader/a nil, :a/b nil, :d nil} ))
(is (= #::s{1 nil, :a nil, :a/b nil, :_/d nil}
#::s {1 nil, :a nil, :a/b nil, :_/d nil}
{1 nil, :clojure.string/a nil, :a/b nil, :d nil}))
(is (= (read-string "#:a{b 1 b/c 2}") {'a/b 1, 'b/c 2}))
(is (= (binding [*ns* (the-ns 'clojure.test-clojure.reader)] (read-string "#::{b 1, b/c 2, _/d 3}")) {'clojure.test-clojure.reader/b 1, 'b/c 2, 'd 3}))
(is (= (binding [*ns* (the-ns 'clojure.test-clojure.reader)] (read-string "#::s{b 1, b/c 2, _/d 3}")) {'clojure.string/b 1, 'b/c 2, 'd 3})))
(deftest namespaced-map-errors
(are [err msg form] (thrown-with-msg? err msg (read-string form))
Exception #"Invalid token" "#:::"
Exception #"Namespaced map literal must contain an even number of forms" "#:s{1}"
Exception #"Namespaced map must specify a valid namespace" "#:s/t{1 2}"
Exception #"Unknown auto-resolved namespace alias" "#::BOGUS{1 2}"
Exception #"Namespaced map must specify a namespace" "#: s{:a 1}"
Exception #"Duplicate key: :user/a" "#::{:a 1 :a 2}"
Exception #"Duplicate key: user/a" "#::{a 1 a 2}"))
(deftest namespaced-map-edn
(is (= {1 1, :a/b 2, :b/c 3, :d 4}
(edn/read-string "#:a{1 1, :b 2, :b/c 3, :_/d 4}")
(edn/read-string "#:a {1 1, :b 2, :b/c 3, :_/d 4}"))))
(deftest invalid-symbol-value
(is (thrown-with-msg? Exception #"Invalid token" (read-string "##5")))
(is (thrown-with-msg? Exception #"Invalid token" (edn/read-string "##5")))
(is (thrown-with-msg? Exception #"Unknown symbolic value" (read-string "##Foo")))
(is (thrown-with-msg? Exception #"Unknown symbolic value" (edn/read-string "##Foo"))))
(deftest test-read+string
(let [[r s] (read+string (str->lnpr "[:foo 100]"))]
(is (= [:foo 100] r))
(is (= "[:foo 100]" s)))
(deftest t-Explicit-line-column-numbers
(is (= {:line 42 :column 99}
(-> "^{:line 42 :column 99} (1 2)" read-string meta (select-keys [:line :column]))))
clojure
(ns clojure.test-clojure.protocols
(:use clojure.test clojure.test-clojure.protocols.examples)
(:require [clojure.test-clojure.protocols.more-examples :as other]
[clojure.set :as set]
clojure.test-helper)
(:import [clojure.test_clojure.protocols.examples ExampleInterface]))
(deftest protocols-test
(testing "protocol fns have useful metadata"
(let [common-meta {:ns (find-ns 'clojure.test-clojure.protocols.examples)
:protocol #'ExampleProtocol :tag nil}]
(are [m f] (= (merge common-meta m)
(meta (var f)))
{:name 'foo :arglists '([a]) :doc "method with one arg"} foo
{:name 'bar :arglists '([a b]) :doc "method with two args"} bar
{:name 'baz :arglists '([a] [a b]) :doc "method with multiple arities" :tag 'java.lang.String} baz
{:name 'with-quux :arglists '([a]) :doc "method name with a hyphen"} with-quux)))
(testing "protocol fns throw IllegalArgumentException if no impl matches"
(is (thrown-with-msg?
IllegalArgumentException
#"No implementation of method: :foo of protocol: #'clojure.test-clojure.protocols.examples/ExampleProtocol found for class: java.lang.Long"
(foo 10))))
(testing "protocols generate a corresponding interface using _ instead of - for method names"
(is (= ["bar" "baz" "baz" "foo" "with_quux"] (method-names clojure.test_clojure.protocols.examples.ExampleProtocol))))
(testing "protocol will work with instances of its interface (use for interop, not in Clojure!)"
(let [obj (proxy [clojure.test_clojure.protocols.examples.ExampleProtocol] []
(foo [] "foo!"))]
(is (= "foo!" (.foo obj)) "call through interface")
(is (= "foo!" (foo obj)) "call through protocol")))
(testing "you can implement just part of a protocol if you want"
(let [obj (reify ExampleProtocol
(baz [a b] "two-arg baz!"))]
(is (= "two-arg baz!" (baz obj nil)))
(is (thrown? AbstractMethodError (baz obj)))))
(testing "error conditions checked when defining protocols"
(is (thrown-with-cause-msg?
Exception
#"Definition of function m in protocol badprotdef must take at least one arg."
(eval '(defprotocol badprotdef (m [])))))
(is (thrown-with-cause-msg?
Exception
#"Function m in protocol badprotdef was redefined. Specify all arities in single definition."
(eval '(defprotocol badprotdef (m [this arg]) (m [this arg1 arg2]))))))
(testing "you can redefine a protocol with different methods"
(eval '(defprotocol Elusive (old-method [x])))
(eval '(defprotocol Elusive (new-method [x])))
(is (= :new-method (eval '(new-method (reify Elusive (new-method [x] :new-method))))))
(is (fails-with-cause? IllegalArgumentException #"No method of interface: .*\.Elusive found for function: old-method of protocol: Elusive \(The protocol method may have been defined before and removed\.\)"
(eval '(old-method (reify Elusive (new-method [x] :new-method))))))))
(deftest marker-tests
(testing "That a marker protocol has no methods"
(is (= '() (method-names clojure.test_clojure.protocols.examples.MarkerProtocol))))
(testing "That types with markers are reportedly satifying them."
(let [hm (HasMarkers.)
wgm (WillGetMarker.)]
(is (satisfies? MarkerProtocol hm))
(is (satisfies? MarkerProtocol2 hm))
(is (satisfies? MarkerProtocol wgm)))))
(deftype ExtendTestWidget [name])
(deftype HasProtocolInline []
ExampleProtocol
(foo [this] :inline))
(deftest extend-test
(testing "you can extend a protocol to a class"
(extend String ExampleProtocol
{:foo identity})
(is (= "pow" (foo "pow"))))
(testing "you can have two methods with the same name. Just use namespaces!"
(extend String other/SimpleProtocol
{:foo (fn [s] (.toUpperCase s))})
(is (= "POW" (other/foo "pow"))))
(testing "you can extend deftype types"
(extend
ExtendTestWidget
ExampleProtocol
{:foo (fn [this] (str "widget " (.name this)))})
(is (= "widget z" (foo (ExtendTestWidget. "z"))))))
(deftest record-marker-interfaces
(testing "record? and type? return expected result for IRecord and IType"
(let [r (TestRecord. 1 2)]
(is (record? r)))))
(deftest illegal-extending
(testing "you cannot extend a protocol to a type that implements the protocol inline"
(is (fails-with-cause? IllegalArgumentException #".*HasProtocolInline already directly implements interface"
(eval '(extend clojure.test_clojure.protocols.HasProtocolInline
clojure.test-clojure.protocols.examples/ExampleProtocol
{:foo (fn [_] :extended)})))))
(testing "you cannot extend to an interface"
(is (fails-with-cause? IllegalArgumentException #"interface clojure.test_clojure.protocols.examples.ExampleProtocol is not a protocol"
(eval '(extend clojure.test_clojure.protocols.HasProtocolInline
clojure.test_clojure.protocols.examples.ExampleProtocol
{:foo (fn [_] :extended)}))))))
(deftype ExtendsTestWidget []
ExampleProtocol)
#_(deftest extends?-test
(reload-example-protocols)
(testing "returns false if a type does not implement the protocol at all"
(is (false? (extends? other/SimpleProtocol ExtendsTestWidget))))
(testing "returns true if a type implements the protocol directly" ;; semantics changed 4/15/2010
(is (true? (extends? ExampleProtocol ExtendsTestWidget))))
(testing "returns true if a type explicitly extends protocol"
(extend
ExtendsTestWidget
other/SimpleProtocol
{:foo identity})
(is (true? (extends? other/SimpleProtocol ExtendsTestWidget)))))
(deftype ExtendersTestWidget [])
#_(deftest extenders-test
(reload-example-protocols)
(testing "a fresh protocol has no extenders"
(is (nil? (extenders ExampleProtocol))))
(testing "extending with no methods doesn't count!"
(deftype Something [])
(extend ::Something ExampleProtocol)
(is (nil? (extenders ExampleProtocol))))
(testing "extending a protocol (and including an impl) adds an entry to extenders"
(extend ExtendersTestWidget ExampleProtocol {:foo identity})
(is (= [ExtendersTestWidget] (extenders ExampleProtocol)))))
(deftype SatisfiesTestWidget []
ExampleProtocol)
#_(deftest satisifies?-test
(reload-example-protocols)
(let [whatzit (SatisfiesTestWidget.)]
(testing "returns false if a type does not implement the protocol at all"
(is (false? (satisfies? other/SimpleProtocol whatzit))))
(testing "returns true if a type implements the protocol directly"
(is (true? (satisfies? ExampleProtocol whatzit))))
(testing "returns true if a type explicitly extends protocol"
(extend
SatisfiesTestWidget
other/SimpleProtocol
{:foo identity})
(is (true? (satisfies? other/SimpleProtocol whatzit))))) )
(deftype ReExtendingTestWidget [])
#_(deftest re-extending-test
(reload-example-protocols)
(extend
ReExtendingTestWidget
ExampleProtocol
{:foo (fn [_] "first foo")
:baz (fn [_] "first baz")})
(testing "if you re-extend, the old implementation is replaced (not merged!)"
(extend
ReExtendingTestWidget
ExampleProtocol
{:baz (fn [_] "second baz")
:bar (fn [_ _] "second bar")})
(let [whatzit (ReExtendingTestWidget.)]
(is (thrown? IllegalArgumentException (foo whatzit)))
(is (= "second bar" (bar whatzit nil)))
(is (= "second baz" (baz whatzit))))))
(defrecord DefrecordObjectMethodsWidgetA [a])
(defrecord DefrecordObjectMethodsWidgetB [a])
(deftest defrecord-object-methods-test
(testing "= depends on fields and type"
(is (true? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetA. 1))))
(is (false? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetA. 2))))
(is (false? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetB. 1))))))
(deftest defrecord-acts-like-a-map
(let [rec (r 1 2)]
(is (.equals (r 1 3 {} {:c 4}) (merge rec {:b 3 :c 4})))
(is (.equals {:foo 1 :b 2} (set/rename-keys rec {:a :foo})))
(is (.equals {:a 11 :b 2 :c 10} (merge-with + rec {:a 10 :c 10})))))
(deftest degenerate-defrecord-test
(let [empty (EmptyRecord.)]
(is (nil? (seq empty)))
(is (not (.containsValue empty :a)))))
(deftest defrecord-interfaces-test
(testing "java.util.Map"
(let [rec (r 1 2)]
(is (= 2 (.size rec)))
(is (= 3 (.size (assoc rec :c 3))))
(is (not (.isEmpty rec)))
(is (.isEmpty (EmptyRecord.)))
(is (.containsKey rec :a))
(is (not (.containsKey rec :c)))
(is (.containsValue rec 1))
(is (not (.containsValue rec 3)))
(is (= 1 (.get rec :a)))
(is (thrown? UnsupportedOperationException (.put rec :a 1)))
(is (thrown? UnsupportedOperationException (.remove rec :a)))
(is (thrown? UnsupportedOperationException (.putAll rec {})))
(is (thrown? UnsupportedOperationException (.clear rec)))
(is (= #{:a :b} (.keySet rec)))
(is (= #{1 2} (set (.values rec))))
(is (= #{[:a 1] [:b 2]} (.entrySet rec)))
))
(testing "IPersistentCollection"
(testing ".cons"
(let [rec (r 1 2)]
(are [x] (= rec (.cons rec x))
nil {})
(is (= (r 1 3) (.cons rec {:b 3})))
(is (= (r 1 4) (.cons rec [:b 4])))
(is (= (r 1 5) (.cons rec (MapEntry. :b 5))))))))
(defrecord RecordWithSpecificFieldNames [this that k m o])
(deftest defrecord-with-specific-field-names
(let [rec (new RecordWithSpecificFieldNames 1 2 3 4 5)]
(is (= rec rec))
(is (= 1 (:this (with-meta rec {:foo :bar}))))
(is (= 3 (get rec :k)))
(is (= (seq rec) '([:this 1] [:that 2] [:k 3] [:m 4] [:o 5])))
(is (= (dissoc rec :k) {:this 1, :that 2, :m 4, :o 5}))))
(deftest test-statics
(testing "that a record has its generated static methods"
(let [r1 (RecordToTestStatics1. 1)
r2 (RecordToTestStatics2. 1 2)
r3 (RecordToTestStatics3. 1 2 3)
rn (RecordToTestStatics3. 1 nil nil)]
(testing "that a record created with the ctor equals one by the static factory method"
(is (= r1 (RecordToTestStatics1/create {:a 1})))
(is (= r2 (RecordToTestStatics2/create {:a 1 :b 2})))
(is (= r3 (RecordToTestStatics3/create {:a 1 :b 2 :c 3})))
(is (= rn (RecordToTestStatics3/create {:a 1}))))
(testing "that a literal record equals one by the static factory method"
(is (= #clojure.test_clojure.protocols.RecordToTestStatics1{:a 1} (RecordToTestStatics1/create {:a 1})))
(is (= #clojure.test_clojure.protocols.RecordToTestStatics2{:a 1 :b 2} (RecordToTestStatics2/create {:a 1 :b 2})))
(is (= #clojure.test_clojure.protocols.RecordToTestStatics3{:a 1 :b 2 :c 3} (RecordToTestStatics3/create {:a 1 :b 2 :c 3})))
(is (= #clojure.test_clojure.protocols.RecordToTestStatics3{:a 1} (RecordToTestStatics3/create {:a 1})))
(is (= #clojure.test_clojure.protocols.RecordToTestStatics3{:a 1 :b nil :c nil} (RecordToTestStatics3/create {:a 1}))))))
(testing "that records and types have a sane generated basis method"
(let [rb (clojure.test_clojure.protocols.RecordToTestBasis/getBasis)
rbh (clojure.test_clojure.protocols.RecordToTestBasisHinted/getBasis)
rhg (clojure.test_clojure.protocols.RecordToTestHugeBasis/getBasis)
tb (clojure.test_clojure.protocols.TypeToTestBasis/getBasis)
tbh (clojure.test_clojure.protocols.TypeToTestBasisHinted/getBasis)]
(is (= '[a b c] rb))
(is (= '[a b c] rb))
(is (= '[a b c d e f g h i j k l m n o p q r s t u v w x y z] rhg))
(testing "that record basis hinting looks as we expect"
(is (= (:tag (meta (rbh 0))) 'String))
(is (= (:tag (meta (rbh 1))) 'Long))
(is (nil? (:tag (meta (rbh 2))))))
(testing "that type basis hinting looks as we expect"
(is (= (:tag (meta (tbh 0))) 'String))
(is (= (:tag (meta (tbh 1))) 'Long))
(is (nil? (:tag (meta (tbh 2)))))))))
(deftest test-record-factory-fns
(testing "if the definition of a defrecord generates the appropriate factory functions"
(let [r (RecordToTestFactories. 1 2 3)
r-n (RecordToTestFactories. nil nil nil)
huge (RecordToTestHugeFactories. 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26)
r-a (map->RecordToTestA {:a 1 :b 2})
r-b (map->RecordToTestB {:a 1 :b 2})
r-d (RecordToTestDegenerateFactories.)]
(testing "that a record created with the ctor equals one by the positional factory fn"
(is (= r (->RecordToTestFactories 1 2 3)))
(is (= huge (->RecordToTestHugeFactories 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26))))
(testing "that a record created with the ctor equals one by the map-> factory fn"
(is (= r (map->RecordToTestFactories {:a 1 :b 2 :c 3})))
(is (= r-n (map->RecordToTestFactories {})))
(is (= r (map->RecordToTestFactories (map->RecordToTestFactories {:a 1 :b 2 :c 3}))))
(is (= r-n (map->RecordToTestFactories (map->RecordToTestFactories {}))))
(is (= r-d (map->RecordToTestDegenerateFactories {})))
(is (= r-d (map->RecordToTestDegenerateFactories
(map->RecordToTestDegenerateFactories {})))))
(testing "that ext maps work correctly"
(is (= (assoc r :xxx 42) (map->RecordToTestFactories {:a 1 :b 2 :c 3 :xxx 42})))
(is (= (assoc r :xxx 42) (map->RecordToTestFactories (map->RecordToTestFactories
{:a 1 :b 2 :c 3 :xxx 42}))))
(is (= (assoc r-n :xxx 42) (map->RecordToTestFactories {:xxx 42})))
(is (= (assoc r-n :xxx 42) (map->RecordToTestFactories (map->RecordToTestFactories
{:xxx 42}))))
(is (= (assoc r-d :xxx 42) (map->RecordToTestDegenerateFactories {:xxx 42})))
(is (= (assoc r-d :xxx 42) (map->RecordToTestDegenerateFactories
(map->RecordToTestDegenerateFactories {:xxx 42})))))
(testing "record equality"
(is (not= r-a r-b))
(is (= (into {} r-a) (into {} r-b)))
(is (not= (into {} r-a) r-b))
(is (= (map->RecordToTestA {:a 1 :b 2})
(map->RecordToTestA (map->RecordToTestB {:a 1 :b 2}))))
(is (= (map->RecordToTestA {:a 1 :b 2 :c 3})
(map->RecordToTestA (map->RecordToTestB {:a 1 :b 2 :c 3}))))
(is (= (map->RecordToTestA {:a 1 :d 4})
(map->RecordToTestA (map->RecordToTestDegenerateFactories {:a 1 :d 4}))))
(is (= r-n (map->RecordToTestFactories (java.util.HashMap.))))
(is (= r-a (map->RecordToTestA (into {} r-b))))
(is (= r-a (map->RecordToTestA r-b)))
(is (not= r-a (map->RecordToTestB r-a)))
(is (= r (assoc r-n :a 1 :b 2 :c 3)))
(is (not= r-a (assoc r-n :a 1 :b 2)))
(is (not= (assoc r-b :c 3 :d 4) (assoc r-n :a 1 :b 2 :c 3 :d 4)))
(is (= (into {} (assoc r-b :c 3 :d 4)) (into {} (assoc r-n :a 1 :b 2 :c 3 :d 4))))
(is (= (assoc r :d 4) (assoc r-n :a 1 :b 2 :c 3 :d 4))))
(testing "that factory functions have docstrings"
;; just test non-nil to avoid overspecifiying what's in the docstring
(is (false? (-> ->RecordToTestFactories var meta :doc nil?)))
(is (false? (-> map->RecordToTestFactories var meta :doc nil?))))
(testing "that a literal record equals one by the positional factory fn"
(is (= #clojure.test_clojure.protocols.RecordToTestFactories{:a 1 :b 2 :c 3} (->RecordToTestFactories 1 2 3)))
(is (= #clojure.test_clojure.protocols.RecordToTestFactories{:a 1 :b nil :c nil} (->RecordToTestFactories 1 nil nil)))
(is (= #clojure.test_clojure.protocols.RecordToTestFactories{:a [] :b {} :c ()} (->RecordToTestFactories [] {} ()))))
(testing "that a literal record equals one by the map-> factory fn"
(is (= #clojure.test_clojure.protocols.RecordToTestFactories{:a 1 :b 2 :c 3} (map->RecordToTestFactories {:a 1 :b 2 :c 3})))
(is (= #clojure.test_clojure.protocols.RecordToTestFactories{:a 1 :b nil :c nil} (map->RecordToTestFactories {:a 1})))
(is (= #clojure.test_clojure.protocols.RecordToTestFactories{:a nil :b nil :c nil} (map->RecordToTestFactories {})))))))
(deftest deftype-factory-fn
(testing "that the ->T factory is gen'd for a deftype and that it works"
(is (= (.a (TypeToTestFactory. 42)) (.a (->TypeToTestFactory 42))))
(is (compare-huge-types
(TypeToTestHugeFactories. 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26)
(->TypeToTestHugeFactories 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26))))
(testing "that the generated factory checks arity constraints"
(is (thrown? clojure.lang.ArityException (->TypeToTestHugeFactories 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25)))
(is (thrown? clojure.lang.ArityException (->TypeToTestHugeFactories 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27)))))
(deftest test-ctor-literals
(testing "that constructor calls to print-dup'able classes are supported as literals"
(is (= "Hi" #java.lang.String["Hi"]))
(is (= 42 #java.lang.Long[42]))
(is (= 42 #java.lang.Long["42"]))
(is (= [:a 42] #clojure.lang.MapEntry[:a 42])))
(testing "that constructor literals are embeddable"
(is (= 42 #java.lang.Long[#java.lang.String["42"]])))
(testing "that constructor literals work for deftypes too"
(is (= (.a (TypeToTestFactory. 42)) (.a #clojure.test_clojure.protocols.TypeToTestFactory[42])))
(is (compare-huge-types
(TypeToTestHugeFactories. 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26)
#clojure.test_clojure.protocols.TypeToTestHugeFactories[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26]))))
(defrecord RecordToTestLiterals [a])
(defrecord TestNode [v l r])
(deftype TypeToTestLiterals [a])
(def lang-str "en")
(deftest exercise-literals
(testing "that ctor literals can be used in common 'places'"
(is (= (RecordToTestLiterals. ()) #clojure.test_clojure.protocols.RecordToTestLiterals[()]))
(is (= (.a (TypeToTestLiterals. ())) (.a #clojure.test_clojure.protocols.TypeToTestLiterals[()])))
(is (= (RecordToTestLiterals. 42) (into #clojure.test_clojure.protocols.RecordToTestLiterals[0] {:a 42})))
(is (= (RecordToTestLiterals. (RecordToTestLiterals. 42)) (RecordToTestLiterals. #clojure.test_clojure.protocols.RecordToTestLiterals[42])))
(is (= (RecordToTestLiterals. (RecordToTestLiterals. 42)) (->RecordToTestLiterals #clojure.test_clojure.protocols.RecordToTestLiterals[42])))
(is (= (RecordToTestLiterals. (RecordToTestLiterals. 42))
#clojure.test_clojure.protocols.RecordToTestLiterals[#clojure.test_clojure.protocols.RecordToTestLiterals[42]]))
(is (= (TestNode. 1
(TestNode. 2
(TestNode. 3
nil
nil)
nil)
(TestNode. 4
(TestNode. 5
(TestNode. 6
nil
nil)
nil)
(TestNode. 7
nil
nil)))
#clojure.test_clojure.protocols.TestNode{:v 1
:l #clojure.test_clojure.protocols.TestNode{:v 2
:l #clojure.test_clojure.protocols.TestNode{:v 3 :l nil :r nil}
:r nil}
:r #clojure.test_clojure.protocols.TestNode{:v 4
:l #clojure.test_clojure.protocols.TestNode{:v 5
:l #clojure.test_clojure.protocols.TestNode{:v 6 :l nil :r nil}
:r nil}
:r #clojure.test_clojure.protocols.TestNode{:v 7 :l nil :r nil}}})))
(defrecord RecordToTestPrinting [a b])
(deftest defrecord-printing
(testing "that the default printer gives the proper representation"
(let [r (RecordToTestPrinting. 1 2)]
(is (= "#clojure.test_clojure.protocols.RecordToTestPrinting{:a 1, :b 2}"
(pr-str r)))
(is (= "#clojure.test_clojure.protocols.RecordToTestPrinting[1, 2]"
(binding [*print-dup* true] (pr-str r))))
(is (= "#clojure.test_clojure.protocols.RecordToTestPrinting{:a 1, :b 2}"
(binding [*print-dup* true *verbose-defrecords* true] (pr-str r)))))))
(deftest test-record-and-type-field-names
(testing "that types and records allow names starting with double-underscore.
This is a regression test for CLJ-837."
(let [r (RecordToTest__. 1 2)
t (TypeToTest__. 3 4)]
(are [x y] (= x y)
1 (:__a r)
2 (:___b r)
3 (.__a t)
4 (.___b t)))))
(deftest hinting-test
(testing "that primitive hinting requiring no coercion works as expected"
(is (= (RecordToTestLongHint. 42) #clojure.test_clojure.protocols.RecordToTestLongHint{:a 42}))
(is (= (RecordToTestLongHint. 42) #clojure.test_clojure.protocols.RecordToTestLongHint[42]))
(is (= (RecordToTestLongHint. 42) (clojure.test_clojure.protocols.RecordToTestLongHint/create {:a 42})))
(is (= (RecordToTestLongHint. 42) (map->RecordToTestLongHint {:a 42})))
(is (= (RecordToTestLongHint. 42) (->RecordToTestLongHint 42)))
(is (= (.a (TypeToTestLongHint. 42)) (.a (->TypeToTestLongHint (long 42)))))
(testing "that invalid primitive types on hinted defrecord fields fails"
(is (thrown?
ClassCastException
(read-string "#clojure.test_clojure.protocols.RecordToTestLongHint{:a \"\"}")))
(is (thrown?
IllegalArgumentException
(read-string "#clojure.test_clojure.protocols.RecordToTestLongHint[\"\"]")))
(is (thrown?
IllegalArgumentException
(read-string "#clojure.test_clojure.protocols.TypeToTestLongHint[\"\"]")))
(is (thrown?
ClassCastException
(clojure.test_clojure.protocols.RecordToTestLongHint/create {:a ""})))
(is (thrown?
ClassCastException
(map->RecordToTestLongHint {:a ""})))
(is (thrown?
ClassCastException
(->RecordToTestLongHint "")))))
(testing "that primitive hinting requiring coercion works as expected"
(is (= (RecordToTestByteHint. 42) (clojure.test_clojure.protocols.RecordToTestByteHint/create {:a (byte 42)})))
(is (= (RecordToTestByteHint. 42) (map->RecordToTestByteHint {:a (byte 42)})))
(is (= (RecordToTestByteHint. 42) (->RecordToTestByteHint (byte 42))))
(is (= (.a (TypeToTestByteHint. 42)) (.a (->TypeToTestByteHint (byte 42))))))
(testing "that primitive hinting for non-numerics works as expected"
(is (= (RecordToTestBoolHint. true) #clojure.test_clojure.protocols.RecordToTestBoolHint{:a true}))
(is (= (RecordToTestBoolHint. true) #clojure.test_clojure.protocols.RecordToTestBoolHint[true]))
(is (= (RecordToTestBoolHint. true) (clojure.test_clojure.protocols.RecordToTestBoolHint/create {:a true})))
(is (= (RecordToTestBoolHint. true) (map->RecordToTestBoolHint {:a true})))
(is (= (RecordToTestBoolHint. true) (->RecordToTestBoolHint true))))
(testing "covariant hints -- deferred"))
(deftest reify-test
(testing "of an interface"
(let [s :foo
r (reify
java.util.List
(contains [_ o] (= s o)))]
(testing "implemented methods"
(is (true? (.contains r :foo)))
(is (false? (.contains r :bar))))
(testing "unimplemented methods"
(is (thrown? AbstractMethodError (.add r :baz))))))
(testing "of two interfaces"
(let [r (reify
java.util.List
(contains [_ o] (= :foo o))
java.util.Collection
(isEmpty [_] false))]
(is (true? (.contains r :foo)))
(is (false? (.contains r :bar)))
(is (false? (.isEmpty r)))))
(testing "you can't define a method twice"
(is (thrown? Exception
(eval '(reify
java.util.List
(size [_] 10)
java.util.Collection
(size [_] 20))))))
(testing "you can't define a method not on an interface/protocol/j.l.Object"
(is (thrown? Exception
(eval '(reify java.util.List (foo [_]))))))
(testing "of a protocol"
(let [r (reify
ExampleProtocol
(bar [this o] o)
(baz [this] 1)
(baz [this o] 2))]
(is (= :foo (.bar r :foo)))
(is (= 1 (.baz r)))
(is (= 2 (.baz r nil)))))
(testing "destructuring in method def"
(let [r (reify
ExampleProtocol
(bar [this [_ _ item]] item))]
(is (= :c (.bar r [:a :b :c])))))
(testing "methods can recur"
(let [r (reify
java.util.List
(get [_ index]
(if (zero? index)
:done
(recur (dec index)))))]
(is (= :done (.get r 0)))
(is (= :done (.get r 1)))))
(testing "disambiguating with type hints"
(testing "you must hint an overloaded method"
(is (thrown? Exception
(eval '(reify clojure.test_clojure.protocols.examples.ExampleInterface (hinted [_ o]))))))
(testing "hinting"
(let [r (reify
ExampleInterface
(hinted [_ ^int i] (inc i))
(hinted [_ ^String s] (str s s)))]
(is (= 2 (.hinted r 1)))
(is (= "xoxo" (.hinted r "xo")))))))
(deftest test-no-ns-capture
(is (= "foo" (sqtp "foo")))
(is (= :foo (sqtp :foo))))
(deftest test-leading-dashes
(is (= 10 (-do-dashed (Dashed.))))
(is (= [10] (map -do-dashed [(Dashed.)]))))
(deftest test-base-reduce-kv
(is (= {1 :a 2 :b}
(reduce-kv #(assoc %1 %3 %2)
{}
(seq {:a 1 :b 2})))))
(deftest test-longs-hinted-proto
(is (= 1
(aget-long-hinted
(reify LongsHintedProto
(longs-hinted [_] (long-array [1])))))))
(import 'clojure.lang.ISeq)
(defprotocol P
(^ISeq f [_]))
(ns clojure.test-clojure.protocols.other
(:use clojure.test))
(defn cf [val]
(let [aseq (clojure.test-clojure.protocols/f val)]
(count aseq)))
(extend-protocol clojure.test-clojure.protocols/P String
(f [s] (seq s)))
(deftest test-resolve-type-hints-in-protocol-methods
(is (= 4 (clojure.test-clojure.protocols/f "test"))))
clojure
(ns clojure.test-clojure.parse
(:require
[clojure.test :refer :all]
[clojure.test.check :as chk]
[clojure.test.check.generators :as gen]
[clojure.test.check.properties :as prop])
(:import
[java.util UUID]))
(deftest test-parse-long
(are [s expected]
(= expected (parse-long s))
"100" 100
"+100" 100
"0" 0
"+0" 0
"-0" 0
"-42" -42
"9223372036854775807" Long/MAX_VALUE
"+9223372036854775807" Long/MAX_VALUE
"-9223372036854775808" Long/MIN_VALUE
"077" 77) ;; leading 0s are ignored! (not octal)
;; generative test - gen long -> str -> parse, compare
(deftest test-gen-parse-long
(let [res (chk/quick-check
100000
(prop/for-all* [gen/large-integer]
#(= % (-> % str parse-long))))]
(if (:result res)
(is true) ;; pass
(is (:result res) (pr-str res)))))
(deftest test-parse-double
(are [s expected]
(= expected (parse-double s))
"1.234" 1.234
"+1.234" 1.234
"-1.234" -1.234
"+0" +0.0
"-0.0" -0.0
"0.0" 0.0
"5" 5.0
"Infinity" Double/POSITIVE_INFINITY
"-Infinity" Double/NEGATIVE_INFINITY
"1.7976931348623157E308" Double/MAX_VALUE
"4.9E-324" Double/MIN_VALUE
"1.7976931348623157E309" Double/POSITIVE_INFINITY ;; past max double
"2.5e-324" Double/MIN_VALUE ;; past min double, above half minimum
"2.4e-324" 0.0) ;; below minimum double
(is (Double/isNaN (parse-double "NaN")))
(are [s] ;; nil on invalid string
(nil? (parse-double s))
"double" ;; invalid string
"1.7976931348623157G309")) ;; invalid, but similar to valid
;; generative test - gen double -> str -> parse, compare
(deftest test-gen-parse-double
(let [res (chk/quick-check
100000
(prop/for-all* [gen/double]
#(let [parsed (-> % str parse-double)]
(if (Double/isNaN %)
(Double/isNaN parsed)
(= % parsed)))))]
(if (:result res)
(is true) ;; pass
(is (:result res) (pr-str res)))))
(deftest test-parse-uuid
(is (parse-uuid (.toString (UUID/randomUUID))))
(is (nil? (parse-uuid "BOGUS"))) ;; nil on invalid uuid string
(are [s] ;; throw on invalid type (not string)
(try (parse-uuid s) (is false) (catch Throwable _ (is true)))
123
nil))
(deftest test-parse-boolean
(is (identical? true (parse-boolean "true")))
(is (identical? false (parse-boolean "false")))
clojure
(ns clojure.test-clojure.numbers
(:use clojure.test
[clojure.test.generative :exclude (is)]
clojure.template)
(:require [clojure.data.generators :as gen]
[clojure.test-helper :as helper]))
(deftest Coerced-BigDecimal
(doseq [v [(bigdec 3) (bigdec (inc (bigint Long/MAX_VALUE)))]]
(are [x] (true? x)
(instance? BigDecimal v)
(number? v)
(decimal? v)
(not (float? v)))))
(deftest BigInteger-conversions
(doseq [coerce-fn [bigint biginteger]]
(doseq [v (map coerce-fn [ Long/MAX_VALUE
13178456923875639284562345789M
13178456923875639284562345789N
Float/MAX_VALUE
(- Float/MAX_VALUE)
Double/MAX_VALUE
(- Double/MAX_VALUE)
(* 2 (bigdec Double/MAX_VALUE)) ])]
(are [x] (true? x)
(integer? v)
(number? v)
(not (decimal? v))
(not (float? v))))))
(deftest equality-tests
;; = only returns true for numbers that are in the same category,
;; where category is one of INTEGER, FLOATING, DECIMAL, RATIO.
(all-pairs-equal #'= [(byte 2) (short 2) (int 2) (long 2)
(bigint 2) (biginteger 2)])
(all-pairs-equal #'= [(float 2.0) (double 2.0)])
(all-pairs-equal #'= [(float 0.0) (double 0.0) (float -0.0) (double -0.0)])
(all-pairs-equal #'= [2.0M 2.00M])
(all-pairs-equal #'= [(float 1.5) (double 1.5)])
(all-pairs-equal #'= [1.50M 1.500M])
(all-pairs-equal #'= [0.0M 0.00M])
(all-pairs-equal #'= [(/ 1 2) (/ 2 4)])
(deftest unchecked-cast-num-obj
(do-template [prim-array cast]
(are [n]
(let [a (prim-array 1)]
(aset a 0 (cast n)))
(Byte. Byte/MAX_VALUE)
(Short. Short/MAX_VALUE)
(Integer. Integer/MAX_VALUE)
(Long. Long/MAX_VALUE)
(Float. Float/MAX_VALUE)
(Double. Double/MAX_VALUE))
byte-array
unchecked-byte
short-array
unchecked-short
char-array
unchecked-char
int-array
unchecked-int
long-array
unchecked-long
float-array
unchecked-float
double-array
unchecked-double))
(deftest unchecked-cast-num-prim
(do-template [prim-array cast]
(are [n]
(let [a (prim-array 1)]
(aset a 0 (cast n)))
Byte/MAX_VALUE
Short/MAX_VALUE
Integer/MAX_VALUE
Long/MAX_VALUE
Float/MAX_VALUE
Double/MAX_VALUE)
byte-array
unchecked-byte
short-array
unchecked-short
char-array
unchecked-char
int-array
unchecked-int
long-array
unchecked-long
float-array
unchecked-float
double-array
unchecked-double))
(deftest unchecked-cast-char
; in keeping with the checked cast functions, char and Character can only be cast to int
(is (unchecked-int (char 0xFFFF)))
(is (let [c (char 0xFFFF)] (unchecked-int c)))) ; force primitive char
(deftest test-expected-casts
(let [[[_ inputs] & expectations] expected-casts]
(doseq [[f vals] expectations]
(let [wrapped (fn [x]
(try
(f x)
(catch RuntimeException e :error)))]
(is (= vals (map wrapped inputs)))))))
(deftest test-prim-with-matching-hint
(is (= 1 (let [x 1.2] (Math/round ^double x)))))
(deftest test-add
(are [x y] (= x y)
(+) 0
(+ 1) 1
(+ 1 2) 3
(+ 1 2 3) 6
(deftest test-subtract
(is (thrown? IllegalArgumentException (-)))
(are [x y] (= x y)
(- 1) -1
(- 1 2) -1
(- 1 2 3) -4
(deftest test-multiply
(are [x y] (= x y)
(*) 1
(* 2) 2
(* 2 3) 6
(* 2 3 4) 24
(deftest test-multiply-longs-at-edge
(are [x] (= x 9223372036854775808N)
(*' -1 Long/MIN_VALUE)
(*' Long/MIN_VALUE -1)
(* -1N Long/MIN_VALUE)
(* Long/MIN_VALUE -1N)
(* -1 (bigint Long/MIN_VALUE))
(* (bigint Long/MIN_VALUE) -1))
(is (thrown? ArithmeticException (* Long/MIN_VALUE -1)))
(is (thrown? ArithmeticException (* -1 Long/MIN_VALUE))))
(deftest test-ratios-simplify-to-ints-where-appropriate
(testing "negative denominator (assembla #275)"
(is (integer? (/ 1 -1/2)))
(is (integer? (/ 0 -1/2)))))
(deftest test-divide
(are [x y] (= x y)
(/ 1) 1
(/ 2) 1/2
(/ 3 2) 3/2
(/ 4 2) 2
(/ 24 3 2) 4
(/ 24 3 2 -1) -4
(deftest test-divide-bigint-at-edge
(are [x] (= x (-' Long/MIN_VALUE))
(/ Long/MIN_VALUE -1N)
(/ (bigint Long/MIN_VALUE) -1)
(/ (bigint Long/MIN_VALUE) -1N)
(quot Long/MIN_VALUE -1N)
(quot (bigint Long/MIN_VALUE) -1)
(quot (bigint Long/MIN_VALUE) -1N)))
(deftest test-mod
; wrong number of args
; (is (thrown? IllegalArgumentException (mod)))
; (is (thrown? IllegalArgumentException (mod 1)))
; (is (thrown? IllegalArgumentException (mod 3 2 1)))
(deftest test-rem
; wrong number of args
; (is (thrown? IllegalArgumentException (rem)))
; (is (thrown? IllegalArgumentException (rem 1)))
; (is (thrown? IllegalArgumentException (rem 3 2 1)))
(deftest test-quot
; wrong number of args
; (is (thrown? IllegalArgumentException (quot)))
; (is (thrown? IllegalArgumentException (quot 1)))
; (is (thrown? IllegalArgumentException (quot 3 2 1)))
(deftest test-pos?-zero?-neg?
(let [nums [[(byte 2) (byte 0) (byte -2)]
[(short 3) (short 0) (short -3)]
[(int 4) (int 0) (int -4)]
[(long 5) (long 0) (long -5)]
[(bigint 6) (bigint 0) (bigint -6)]
[(float 7) (float 0) (float -7)]
[(double 8) (double 0) (double -8)]
[(bigdec 9) (bigdec 0) (bigdec -9)]
[2/3 0 -2/3]]
pred-result [[pos? [true false false]]
[zero? [false true false]]
[neg? [false false true]]] ]
(doseq [pr pred-result]
(doseq [n nums]
(is (= (map (first pr) n) (second pr))
(pr-str (first pr) n))))))
(deftest test-even?
(are [x] (true? x)
(even? -4)
(not (even? -3))
(even? 0)
(not (even? 5))
(even? 8))
(is (thrown? IllegalArgumentException (even? 1/2)))
(is (thrown? IllegalArgumentException (even? (double 10)))))
(deftest test-odd?
(are [x] (true? x)
(not (odd? -4))
(odd? -3)
(not (odd? 0))
(odd? 5)
(not (odd? 8)))
(is (thrown? IllegalArgumentException (odd? 1/2)))
(is (thrown? IllegalArgumentException (odd? (double 10)))))
(deftest test-bit-shift-left
(are [x y] (= x y)
2r10 (bit-shift-left 2r1 1)
2r100 (bit-shift-left 2r1 2)
2r1000 (bit-shift-left 2r1 3)
2r00101110 (bit-shift-left 2r00010111 1)
2r00101110 (apply bit-shift-left [2r00010111 1])
0 (bit-shift-left 2r10 -1) ; truncated to least 6-bits, 63
(expt 2 32) (bit-shift-left 1 32)
(expt 2 16) (bit-shift-left 1 10000) ; truncated to least 6-bits, 16
)
(is (thrown? IllegalArgumentException (bit-shift-left 1N 1))))
(deftest test-bit-shift-right
(are [x y] (= x y)
2r0 (bit-shift-right 2r1 1)
2r010 (bit-shift-right 2r100 1)
2r001 (bit-shift-right 2r100 2)
2r000 (bit-shift-right 2r100 3)
2r0001011 (bit-shift-right 2r00010111 1)
2r0001011 (apply bit-shift-right [2r00010111 1])
0 (bit-shift-right 2r10 -1) ; truncated to least 6-bits, 63
1 (bit-shift-right (expt 2 32) 32)
1 (bit-shift-right (expt 2 16) 10000) ; truncated to least 6-bits, 16
-1 (bit-shift-right -2r10 1)
)
(is (thrown? IllegalArgumentException (bit-shift-right 1N 1))))
(deftest test-unsigned-bit-shift-right
(are [x y] (= x y)
2r0 (unsigned-bit-shift-right 2r1 1)
2r010 (unsigned-bit-shift-right 2r100 1)
2r001 (unsigned-bit-shift-right 2r100 2)
2r000 (unsigned-bit-shift-right 2r100 3)
2r0001011 (unsigned-bit-shift-right 2r00010111 1)
2r0001011 (apply unsigned-bit-shift-right [2r00010111 1])
0 (unsigned-bit-shift-right 2r10 -1) ; truncated to least 6-bits, 63
1 (unsigned-bit-shift-right (expt 2 32) 32)
1 (unsigned-bit-shift-right (expt 2 16) 10000) ; truncated to least 6-bits, 16
9223372036854775807 (unsigned-bit-shift-right -2r10 1)
)
(is (thrown? IllegalArgumentException (unsigned-bit-shift-right 1N 1))))
(deftest test-bit-clear
(is (= 2r1101 (bit-clear 2r1111 1)))
(is (= 2r1101 (bit-clear 2r1101 1))))
(deftest test-bit-set
(is (= 2r1111 (bit-set 2r1111 1)))
(is (= 2r1111 (bit-set 2r1101 1))))
(deftest test-bit-flip
(is (= 2r1101 (bit-flip 2r1111 1)))
(is (= 2r1111 (bit-flip 2r1101 1))))
(deftest test-bit-test
(is (true? (bit-test 2r1111 1)))
(is (false? (bit-test 2r1101 1))))
;; arrays
(deftest test-array-types
(are [x y z] (= (Class/forName x) (class y) (class z))
"[Z" (boolean-array 1) (booleans (boolean-array 1 true))
"[B" (byte-array 1) (bytes (byte-array 1 (byte 1)))
"[C" (char-array 1) (chars (char-array 1 \a))
"[S" (short-array 1) (shorts (short-array 1 (short 1)))
"[F" (float-array 1) (floats (float-array 1 1))
"[D" (double-array 1) (doubles (double-array 1 1))
"[I" (int-array 1) (ints (int-array 1 1))
"[J" (long-array 1) (longs (long-array 1 1))))
(deftest test-ratios
(is (== (denominator 1/2) 2))
(is (== (numerator 1/2) 1))
(is (= (bigint (/ 100000000000000000000 3)) 33333333333333333333))
(is (= (long 10000000000000000000/3) 3333333333333333333))
(deftest test-arbitrary-precision-subtract
(are [x y] (= x y)
9223372036854775808N (-' 0 -9223372036854775808)
clojure.lang.BigInt (class (-' 0 -9223372036854775808))
java.lang.Long (class (-' 0 -9223372036854775807))))
(deftest test-min-max
(testing "min/max on different numbers of floats and doubles"
(are [xmin xmax a]
(and (= (Float. xmin) (min (Float. a)))
(= (Float. xmax) (max (Float. a)))
(= xmin (min a))
(= xmax (max a)))
0.0 0.0 0.0)
(are [xmin xmax a b]
(and (= (Float. xmin) (min (Float. a) (Float. b)))
(= (Float. xmax) (max (Float. a) (Float. b)))
(= xmin (min a b))
(= xmax (max a b)))
-1.0 0.0 0.0 -1.0
-1.0 0.0 -1.0 0.0
0.0 1.0 0.0 1.0
0.0 1.0 1.0 0.0)
(are [xmin xmax a b c]
(and (= (Float. xmin) (min (Float. a) (Float. b) (Float. c)))
(= (Float. xmax) (max (Float. a) (Float. b) (Float. c)))
(= xmin (min a b c))
(= xmax (max a b c)))
-1.0 1.0 0.0 1.0 -1.0
-1.0 1.0 0.0 -1.0 1.0
-1.0 1.0 -1.0 1.0 0.0))
(testing "min/max preserves type of winner"
(is (= java.lang.Long (class (max 10))))
(is (= java.lang.Long (class (max 1.0 10))))
(is (= java.lang.Long (class (max 10 1.0))))
(is (= java.lang.Long (class (max 10 1.0 2.0))))
(is (= java.lang.Long (class (max 1.0 10 2.0))))
(is (= java.lang.Long (class (max 1.0 2.0 10))))
(is (= java.lang.Double (class (max 1 2 10.0 3 4 5))))
(is (= java.lang.Long (class (min 10))))
(is (= java.lang.Long (class (min 1.0 -10))))
(is (= java.lang.Long (class (min -10 1.0))))
(is (= java.lang.Long (class (min -10 1.0 2.0))))
(is (= java.lang.Long (class (min 1.0 -10 2.0))))
(is (= java.lang.Long (class (min 1.0 2.0 -10))))
(is (= java.lang.Double (class (min 1 2 -10.0 3 4 5))))))
(deftest test-abs
(are [in ex] (= ex (abs in))
-1 1
1 1
Long/MIN_VALUE Long/MIN_VALUE ;; special case!
-1.0 1.0
-0.0 0.0
##-Inf ##Inf
##Inf ##Inf
-123.456M 123.456M
-123N 123N
-1/5 1/5)
(is (NaN? (abs ##NaN))))
(deftest clj-868
(testing "min/max: NaN is contagious"
(letfn [(fnan? [^Float x] (Float/isNaN x))
(dnan? [^double x] (Double/isNaN x))]
(are [minmax]
(are [nan? nan zero]
(every? nan? (map minmax
[ nan zero zero]
[zero nan zero]
[zero zero nan]))
fnan? Float/NaN (Float. 0.0)
dnan? Double/NaN 0.0)
min
max))))
(deftest unchecked-inc-overflow
(testing "max value overflows to min value"
(is (= Long/MIN_VALUE (unchecked-inc Long/MAX_VALUE)))
(is (= Long/MIN_VALUE (unchecked-inc (Long/valueOf Long/MAX_VALUE))))))
(deftest unchecked-dec-overflow
(testing "min value overflows to max value"
(is (= Long/MAX_VALUE (unchecked-dec Long/MIN_VALUE)))
(is (= Long/MAX_VALUE (unchecked-dec (Long/valueOf Long/MIN_VALUE))))))
(deftest unchecked-negate-overflow
(testing "negating min value overflows to min value itself"
(is (= Long/MIN_VALUE (unchecked-negate Long/MIN_VALUE)))
(is (= Long/MIN_VALUE (unchecked-negate (Long/valueOf Long/MIN_VALUE))))))
(deftest unchecked-add-overflow
(testing "max value overflows to min value"
(is (= Long/MIN_VALUE (unchecked-add Long/MAX_VALUE 1)))
(is (= Long/MIN_VALUE (unchecked-add Long/MAX_VALUE (Long/valueOf 1))))
(is (= Long/MIN_VALUE (unchecked-add (Long/valueOf Long/MAX_VALUE) 1)))
(is (= Long/MIN_VALUE (unchecked-add (Long/valueOf Long/MAX_VALUE) (Long/valueOf 1)))))
(testing "adding min value to min value results in zero"
(is (= 0 (unchecked-add Long/MIN_VALUE Long/MIN_VALUE)))
(is (= 0 (unchecked-add Long/MIN_VALUE (Long/valueOf Long/MIN_VALUE))))
(is (= 0 (unchecked-add (Long/valueOf Long/MIN_VALUE) Long/MIN_VALUE)))
(is (= 0 (unchecked-add (Long/valueOf Long/MIN_VALUE) (Long/valueOf Long/MIN_VALUE))))))
(deftest unchecked-subtract-overflow
(testing "min value overflows to max-value"
(is (= Long/MAX_VALUE (unchecked-subtract Long/MIN_VALUE 1)))
(is (= Long/MAX_VALUE (unchecked-subtract Long/MIN_VALUE (Long/valueOf 1))))
(is (= Long/MAX_VALUE (unchecked-subtract (Long/valueOf Long/MIN_VALUE) 1)))
(is (= Long/MAX_VALUE (unchecked-subtract (Long/valueOf Long/MIN_VALUE) (Long/valueOf 1)))))
(testing "negating min value overflows to min value itself"
(is (= Long/MIN_VALUE (unchecked-subtract 0 Long/MIN_VALUE)))
(is (= Long/MIN_VALUE (unchecked-subtract 0 (Long/valueOf Long/MIN_VALUE))))
(is (= Long/MIN_VALUE (unchecked-subtract (Long/valueOf 0) Long/MIN_VALUE)))
(is (= Long/MIN_VALUE (unchecked-subtract (Long/valueOf 0) (Long/valueOf Long/MIN_VALUE))))))
(deftest unchecked-multiply-overflow
(testing "two times max value results in -2"
(is (= -2 (unchecked-multiply Long/MAX_VALUE 2)))
(is (= -2 (unchecked-multiply Long/MAX_VALUE (Long/valueOf 2))))
(is (= -2 (unchecked-multiply (Long/valueOf Long/MAX_VALUE) 2)))
(is (= -2 (unchecked-multiply (Long/valueOf Long/MAX_VALUE) (Long/valueOf 2)))))
(testing "two times min value results in 0"
(is (= 0 (unchecked-multiply Long/MIN_VALUE 2)))
(is (= 0 (unchecked-multiply Long/MIN_VALUE (Long/valueOf 2))))
(is (= 0 (unchecked-multiply (Long/valueOf Long/MIN_VALUE) 2)))
(is (= 0 (unchecked-multiply (Long/valueOf Long/MIN_VALUE) (Long/valueOf 2))))))
(deftest warn-on-boxed
(check-warn-on-box true (#(inc %) 2))
(check-warn-on-box false (#(inc ^long %) 2))
(check-warn-on-box false (long-array 5))
(check-warn-on-box true (> (first (range 3)) 0))
(check-warn-on-box false (> ^long (first (range 3)) 0)))
(deftest comparisons
(let [small-numbers [1 1.0 (Integer. 1) (Float. 1.0) 9/10 1N 1M]
big-numbers [10 10.0 (Integer. 10) (Float. 10.0) 99/10 10N 10N]]
(doseq [small small-numbers big big-numbers]
(is (< small big))
(is (not (< big small)))
(is (not (< small small)))
(is (< (int small) (int big)))
(is (not (< (int big) (int small))))
(is (not (< (int small) (int small))))
(is (< (double small) (double big)))
(is (not (< (double big) (double small))))
(is (not (< (double small) (double small))))
(is (<= small big))
(is (<= small small))
(is (not (<= big small)))
(is (<= (int small) (int big)))
(is (<= (int small) (int small)))
(is (not (<= (int big) (int small))))
(is (<= (double small) (double big)))
(is (<= (double small) (double small)))
(is (not (<= (double big) (double small))))
(is (> big small))
(is (not (> small big)))
(is (not (> small small)))
(is (> (int big) (int small)))
(is (not (> (int small) (int big))))
(is (not (> (int small) (int small))))
(is (> (double big) (double small)))
(is (not (> (double small) (double big))))
(is (not (> (double small) (double small))))
(is (>= big small))
(is (>= small small))
(is (not (>= small big)))
(is (>= (int big) (int small)))
(is (>= (int small) (int small)))
(is (not (>= (int small) (int big))))
(is (>= (double big) (double small)))
(is (>= (double small) (double small)))
(is (not (>= (double small) (double big)))))))
(deftest test-nan-comparison
(are [x y] (= x y)
(< 1000 Double/NaN) (< 1000 (Double. Double/NaN))
(<= 1000 Double/NaN) (<= 1000 (Double. Double/NaN))
(> 1000 Double/NaN) (> 1000 (Double. Double/NaN))
(>= 1000 Double/NaN) (>= 1000 (Double. Double/NaN))))
(deftest test-nan-as-operand
(testing "All numeric operations with NaN as an operand produce NaN as a result"
(let [nan Double/NaN
onan (cast Object Double/NaN)]
(are [x] (Double/isNaN x)
(+ nan 1)
(+ nan 0)
(+ nan 0.0)
(+ 1 nan)
(+ 0 nan)
(+ 0.0 nan)
(+ nan nan)
(- nan 1)
(- nan 0)
(- nan 0.0)
(- 1 nan)
(- 0 nan)
(- 0.0 nan)
(- nan nan)
(* nan 1)
(* nan 0)
(* nan 0.0)
(* 1 nan)
(* 0 nan)
(* 0.0 nan)
(* nan nan)
(/ nan 1)
(/ nan 0)
(/ nan 0.0)
(/ 1 nan)
(/ 0 nan)
(/ 0.0 nan)
(/ nan nan)
(+ onan 1)
(+ onan 0)
(+ onan 0.0)
(+ 1 onan)
(+ 0 onan)
(+ 0.0 onan)
(+ onan onan)
(- onan 1)
(- onan 0)
(- onan 0.0)
(- 1 onan)
(- 0 onan)
(- 0.0 onan)
(- onan onan)
(* onan 1)
(* onan 0)
(* onan 0.0)
(* 1 onan)
(* 0 onan)
(* 0.0 onan)
(* onan onan)
(/ onan 1)
(/ onan 0)
(/ onan 0.0)
(/ 1 onan)
(/ 0 onan)
(/ 0.0 onan)
(/ onan onan)
(+ nan onan)
(+ onan nan)
(- nan onan)
(- onan nan)
(* nan onan)
(* onan nan)
(/ nan onan)
(/ onan nan) ))))
clojure
(ns clojure.test-clojure.math
(:require
[clojure.test :refer :all]
[clojure.math :as m]))
(deftest test-sin
(is (NaN? (m/sin ##NaN)))
(is (NaN? (m/sin ##-Inf)))
(is (NaN? (m/sin ##Inf)))
(is (pos-zero? (m/sin 0.0)))
(is (neg-zero? (m/sin -0.0)))
(is (ulp= (m/sin m/PI) (- (m/sin (- m/PI))) 1)))
(deftest test-cos
(is (NaN? (m/cos ##NaN)))
(is (NaN? (m/cos ##-Inf)))
(is (NaN? (m/cos ##Inf)))
(is (= 1.0 (m/cos 0.0) (m/cos -0.0)))
(is (ulp= (m/cos m/PI) (m/cos (- m/PI)) 1)))
(deftest test-tan
(is (NaN? (m/tan ##NaN)))
(is (NaN? (m/tan ##-Inf)))
(is (NaN? (m/tan ##Inf)))
(is (pos-zero? (m/tan 0.0)))
(is (neg-zero? (m/tan -0.0)))
(is (ulp= (- (m/tan m/PI)) (m/tan (- m/PI)) 1)))
(deftest test-asin
(is (NaN? (m/asin ##NaN)))
(is (NaN? (m/asin 2.0)))
(is (NaN? (m/asin -2.0)))
(is (zero? (m/asin -0.0))))
(deftest test-acos
(is (NaN? (m/acos ##NaN)))
(is (NaN? (m/acos -2.0)))
(is (NaN? (m/acos 2.0)))
(is (ulp= (* 2 (m/acos 0.0)) m/PI 1)))
(deftest test-atan
(is (NaN? (m/atan ##NaN)))
(is (pos-zero? (m/atan 0.0)))
(is (neg-zero? (m/atan -0.0)))
(is (ulp= (m/atan 1) 0.7853981633974483 1)))
(deftest test-radians-degrees-roundtrip
(doseq [d (range 0.0 360.0 5.0)]
(is (ulp= (m/round d) (m/round (-> d m/to-radians m/to-degrees)) 1))))
(deftest test-exp
(is (NaN? (m/exp ##NaN)))
(is (= ##Inf (m/exp ##Inf)))
(is (pos-zero? (m/exp ##-Inf)))
(is (ulp= (m/exp 0.0) 1.0 1))
(is (ulp= (m/exp 1) m/E 1)))
(deftest test-log
(is (NaN? (m/log ##NaN)))
(is (NaN? (m/log -1.0)))
(is (= ##Inf (m/log ##Inf)))
(is (= ##-Inf (m/log 0.0)))
(is (ulp= (m/log m/E) 1.0 1)))
(deftest test-log10
(is (NaN? (m/log10 ##NaN)))
(is (NaN? (m/log10 -1.0)))
(is (= ##Inf (m/log10 ##Inf)))
(is (= ##-Inf (m/log10 0.0)))
(is (ulp= (m/log10 10) 1.0 1)))
(deftest test-sqrt
(is (NaN? (m/sqrt ##NaN)))
(is (NaN? (m/sqrt -1.0)))
(is (= ##Inf (m/sqrt ##Inf)))
(is (pos-zero? (m/sqrt 0)))
(is (= (m/sqrt 4.0) 2.0)))
(deftest test-cbrt
(is (NaN? (m/cbrt ##NaN)))
(is (= ##-Inf (m/cbrt ##-Inf)))
(is (= ##Inf (m/cbrt ##Inf)))
(is (pos-zero? (m/cbrt 0)))
(is (= 2.0 (m/cbrt 8.0))))
(deftest test-IEEE-remainder
(is (NaN? (m/IEEE-remainder ##NaN 1.0)))
(is (NaN? (m/IEEE-remainder 1.0 ##NaN)))
(is (NaN? (m/IEEE-remainder ##Inf 2.0)))
(is (NaN? (m/IEEE-remainder ##-Inf 2.0)))
(is (NaN? (m/IEEE-remainder 2 0.0)))
(is (= 1.0 (m/IEEE-remainder 5.0 4.0))))
(deftest test-ceil
(is (NaN? (m/ceil ##NaN)))
(is (= ##Inf (m/ceil ##Inf)))
(is (= ##-Inf (m/ceil ##-Inf)))
(is (= 4.0 (m/ceil m/PI))))
(deftest test-floor
(is (NaN? (m/floor ##NaN)))
(is (= ##Inf (m/floor ##Inf)))
(is (= ##-Inf (m/floor ##-Inf)))
(is (= 3.0 (m/floor m/PI))))
(deftest test-rint
(is (NaN? (m/rint ##NaN)))
(is (= ##Inf (m/rint ##Inf)))
(is (= ##-Inf (m/rint ##-Inf)))
(is (= 1.0 (m/rint 1.2)))
(is (neg-zero? (m/rint -0.01))))
(deftest test-atan2
(is (NaN? (m/atan2 ##NaN 1.0)))
(is (NaN? (m/atan2 1.0 ##NaN)))
(is (pos-zero? (m/atan2 0.0 1.0)))
(is (neg-zero? (m/atan2 -0.0 1.0)))
(is (ulp= (m/atan2 0.0 -1.0) m/PI 2))
(is (ulp= (m/atan2 -0.0 -1.0) (- m/PI) 2))
(is (ulp= (* 2.0 (m/atan2 1.0 0.0)) m/PI 2))
(is (ulp= (* -2.0 (m/atan2 -1.0 0.0)) m/PI 2))
(is (ulp= (* 4.0 (m/atan2 ##Inf ##Inf)) m/PI 2))
(is (ulp= (/ (* 4.0 (m/atan2 ##Inf ##-Inf)) 3.0) m/PI 2))
(is (ulp= (* -4.0 (m/atan2 ##-Inf ##Inf)) m/PI 2))
(is (ulp= (/ (* -4.0 (m/atan2 ##-Inf ##-Inf)) 3.0) m/PI 2)))
(deftest test-pow
(is (= 1.0 (m/pow 4.0 0.0)))
(is (= 1.0 (m/pow 4.0 -0.0)))
(is (= 4.2 (m/pow 4.2 1.0)))
(is (NaN? (m/pow 4.2 ##NaN)))
(is (NaN? (m/pow ##NaN 2.0)))
(is (= ##Inf (m/pow 2.0 ##Inf)))
(is (= ##Inf (m/pow 0.5 ##-Inf)))
(is (= 0.0 (m/pow 2.0 ##-Inf)))
(is (= 0.0 (m/pow 0.5 ##Inf)))
(is (NaN? (m/pow 1.0 ##Inf)))
(is (pos-zero? (m/pow 0.0 1.5)))
(is (pos-zero? (m/pow ##Inf -2.0)))
(is (= ##Inf (m/pow 0.0 -2.0)))
(is (= ##Inf (m/pow ##Inf 2.0)))
(is (pos-zero? (m/pow -0.0 1.5)))
(is (pos-zero? (m/pow ##-Inf -1.5)))
(is (neg-zero? (m/pow -0.0 3.0)))
(is (neg-zero? (m/pow ##-Inf -3.0)))
(is (= ##Inf (m/pow -0.0 -1.5)))
(is (= ##Inf (m/pow ##-Inf 2.5)))
(is (= ##-Inf (m/pow -0.0 -3.0)))
(is (= ##-Inf (m/pow ##-Inf 3.0)))
(is (= 4.0 (m/pow -2.0 2.0)))
(is (= -8.0 (m/pow -2.0 3.0)))
(is (= 8.0 (m/pow 2.0 3.0))))
(deftest test-round
(is (= 0 (m/round ##NaN)))
(is (= Long/MIN_VALUE (m/round ##-Inf)))
(is (= Long/MIN_VALUE (m/round (- Long/MIN_VALUE 2.0))))
(is (= Long/MAX_VALUE (m/round ##Inf)))
(is (= Long/MAX_VALUE (m/round (+ Long/MAX_VALUE 2.0))))
(is (= 4 (m/round 3.5))))
(deftest test-add-exact
(try
(m/add-exact Long/MAX_VALUE 1)
(is false)
(catch ArithmeticException _
(is true))))
(deftest test-subtract-exact
(try
(m/subtract-exact Long/MIN_VALUE 1)
(is false)
(catch ArithmeticException _
(is true))))
(deftest test-multiply-exact
(try
(m/multiply-exact Long/MAX_VALUE 2)
(is false)
(catch ArithmeticException _
(is true))))
(deftest test-increment-exact
(try
(m/increment-exact Long/MAX_VALUE)
(is false)
(catch ArithmeticException _
(is true))))
(deftest test-decrement-exact
(try
(m/decrement-exact Long/MIN_VALUE)
(is false)
(catch ArithmeticException _
(is true))))
(deftest test-negate-exact
(is (= (inc Long/MIN_VALUE) (m/negate-exact Long/MAX_VALUE)))
(try
(m/negate-exact Long/MIN_VALUE)
(is false)
(catch ArithmeticException _
(is true))))
(deftest test-floor-div
(is (= Long/MIN_VALUE (m/floor-div Long/MIN_VALUE -1)))
(is (= -1 (m/floor-div -2 5))))
(deftest test-floor-mod
(is (= 3 (m/floor-mod -2 5))))
(deftest test-ulp
(is (NaN? (m/ulp ##NaN)))
(is (= ##Inf (m/ulp ##Inf)))
(is (= ##Inf (m/ulp ##-Inf)))
(is (= Double/MIN_VALUE (m/ulp 0.0)))
(is (= (m/pow 2 971) (m/ulp Double/MAX_VALUE)))
(is (= (m/pow 2 971) (m/ulp (- Double/MAX_VALUE)))))
(deftest test-signum
(is (NaN? (m/signum ##NaN)))
(is (zero? (m/signum 0.0)))
(is (zero? (m/signum -0.0)))
(is (= 1.0 (m/signum 42.0)))
(is (= -1.0 (m/signum -42.0))))
(deftest test-sinh
(is (NaN? (m/sinh ##NaN)))
(is (= ##Inf (m/sinh ##Inf)))
(is (= ##-Inf (m/sinh ##-Inf)))
(is (= 0.0 (m/sinh 0.0))))
(deftest test-cosh
(is (NaN? (m/cosh ##NaN)))
(is (= ##Inf (m/cosh ##Inf)))
(is (= ##Inf (m/cosh ##-Inf)))
(is (= 1.0 (m/cosh 0.0))))
(deftest test-tanh
(is (NaN? (m/tanh ##NaN)))
(is (= 1.0 (m/tanh ##Inf)))
(is (= -1.0 (m/tanh ##-Inf)))
(is (= 0.0 (m/tanh 0.0))))
(deftest test-hypot
(is (= ##Inf (m/hypot 1.0 ##Inf)))
(is (= ##Inf (m/hypot ##Inf 1.0)))
(is (NaN? (m/hypot ##NaN 1.0)))
(is (NaN? (m/hypot 1.0 ##NaN)))
(is (= 13.0 (m/hypot 5.0 12.0))))
(deftest test-expm1
(is (NaN? (m/expm1 ##NaN)))
(is (= ##Inf (m/expm1 ##Inf)))
(is (= -1.0 (m/expm1 ##-Inf)))
(is (= 0.0 (m/expm1 0.0))))
(deftest test-log1p
(is (NaN? (m/log1p ##NaN)))
(is (= ##Inf (m/log1p ##Inf)))
(is (= ##-Inf (m/log1p -1.0)))
(is (pos-zero? (m/log1p 0.0)))
(is (neg-zero? (m/log1p -0.0))))
(deftest test-copy-sign
(is (= 1.0 (m/copy-sign 1.0 42.0)))
(is (= -1.0 (m/copy-sign 1.0 -42.0)))
(is (= -1.0 (m/copy-sign 1.0 ##-Inf))))
(deftest test-get-exponent
(is (= (inc Double/MAX_EXPONENT) (m/get-exponent ##NaN)))
(is (= (inc Double/MAX_EXPONENT) (m/get-exponent ##Inf)))
(is (= (inc Double/MAX_EXPONENT) (m/get-exponent ##-Inf)))
(is (= (dec Double/MIN_EXPONENT) (m/get-exponent 0.0)))
(is (= 0 (m/get-exponent 1.0)))
(is (= 13 (m/get-exponent 12345.678))))
(deftest test-next-after
(is (NaN? (m/next-after ##NaN 1)))
(is (NaN? (m/next-after 1 ##NaN)))
(is (pos-zero? (m/next-after 0.0 0.0)))
(is (neg-zero? (m/next-after -0.0 -0.0)))
(is (= Double/MAX_VALUE (m/next-after ##Inf 1.0)))
(is (pos-zero? (m/next-after Double/MIN_VALUE -1.0))))
(deftest test-next-up
(is (NaN? (m/next-up ##NaN)))
(is (= ##Inf (m/next-up ##Inf)))
(is (= Double/MIN_VALUE (m/next-up 0.0))))
(deftest test-next-down
(is (NaN? (m/next-down ##NaN)))
(is (= ##-Inf (m/next-down ##-Inf)))
(is (= (- Double/MIN_VALUE) (m/next-down 0.0))))
(deftest test-scalb
(is (NaN? (m/scalb ##NaN 1)))
(is (= ##Inf (m/scalb ##Inf 1)))
(is (= ##-Inf (m/scalb ##-Inf 1)))
(is (pos-zero? (m/scalb 0.0 2)))
(is (neg-zero? (m/scalb -0.0 2)))
(is (= 32.0 (m/scalb 2.0 4))))
clojure
(ns clojure.test-clojure.java-interop
(:use clojure.test)
(:require [clojure.data :as data]
[clojure.inspector]
[clojure.pprint :as pp]
[clojure.set :as set]
[clojure.test-clojure.proxy.examples :as proxy-examples])
(:import java.util.Base64
(java.util.concurrent.atomic AtomicLong AtomicInteger)))
(deftest test-dot
; (.instanceMember instance args*)
(are [x] (= x "FRED")
(.toUpperCase "fred")
(. "fred" toUpperCase)
(. "fred" (toUpperCase)) )
(deftest test-reflective-field-name-ambiguous
(let [t (->T "field")]
(is (= "method" (. ^T t a)))
(is (= "field" (. ^T t -a)))
(is (= "method" (. t a)))
(is (= "field" (. t -a)))
(is (thrown? IllegalArgumentException (. t -BOGUS)))))
(deftest test-double-dot
(is (= (.. System (getProperties) (get "os.name"))
(. (. System (getProperties)) (get "os.name")))))
(deftest test-doto
(let [m (doto (new java.util.HashMap)
(.put "a" 1)
(.put "b" 2))]
(are [x y] (= x y)
(class m) java.util.HashMap
m {"a" 1 "b" 2} )))
(deftest test-new
; Integer
(are [expr cls value] (and (= (class expr) cls)
(= expr value))
(new java.lang.Integer 42) java.lang.Integer 42
(java.lang.Integer. 123) java.lang.Integer 123 )
(deftest test-instance?
; evaluation
(are [x y] (= x y)
(instance? java.lang.Integer (+ 1 2)) false
(instance? java.lang.Long (+ 1 2)) true )
(deftest test-set!
(is (= 1 (f (t. 1)))))
(deftest test-bean
(let [b (bean java.awt.Color/black)]
(are [x y] (= x y)
(map? b) true
(deftest test-iterable-bean
(let [b (bean (java.util.Date.))]
(is (.iterator ^Iterable b))
(is (= (into [] b) (into [] (seq b))))
(is (hash b))))
(deftest test-proxy-chain
(testing "That the proxy functions can chain"
(are [x y] (= x y)
(-> (get-proxy-class Object)
construct-proxy
(init-proxy {})
(update-proxy {"toString" (fn [_] "chain chain chain")})
str)
"chain chain chain"
;https://clojure.atlassian.net/browse/CLJ-1973
(deftest test-proxy-method-order
(let [class-reader (clojure.asm.ClassReader. proxy-examples/proxy1-class-name)
method-order (atom [])
method-visitor (proxy [clojure.asm.ClassVisitor] [clojure.asm.Opcodes/ASM4 nil]
(visitMethod [access name descriptor signature exceptions]
(swap! method-order conj {:name name :descriptor descriptor})
nil))
_ (.accept class-reader method-visitor 0)
expected [{:name "<init>", :descriptor "()V"}
{:name "__initClojureFnMappings", :descriptor "(Lclojure/lang/IPersistentMap;)V"}
{:name "__updateClojureFnMappings", :descriptor "(Lclojure/lang/IPersistentMap;)V"}
{:name "__getClojureFnMappings", :descriptor "()Lclojure/lang/IPersistentMap;"}
{:name "clone", :descriptor "()Ljava/lang/Object;"}
{:name "hashCode", :descriptor "()I"}
{:name "toString", :descriptor "()Ljava/lang/String;"}
{:name "equals", :descriptor "(Ljava/lang/Object;)Z"}
{:name "a", :descriptor "(Ljava/io/File;)Z"}
{:name "a", :descriptor "(Ljava/lang/Boolean;)Ljava/lang/Object;"}
{:name "a", :descriptor "(Ljava/lang/Runnable;)Z"}
{:name "a", :descriptor "(Ljava/lang/String;)I"}
{:name "b", :descriptor "(Ljava/lang/String;)Ljava/lang/Object;"}
{:name "c", :descriptor "(Ljava/lang/String;)Ljava/lang/Object;"}
{:name "d", :descriptor "(Ljava/lang/String;)Ljava/lang/Object;"}
{:name "a", :descriptor "(Ljava/lang/Boolean;Ljava/lang/String;)I"}
{:name "a", :descriptor "(Ljava/lang/String;Ljava/io/File;)Z"}
{:name "a", :descriptor "(Ljava/lang/String;Ljava/lang/Runnable;)Z"}
{:name "a", :descriptor "(Ljava/lang/String;Ljava/lang/String;)I"}]
actual @method-order]
(is (= expected actual)
(with-out-str (pp/pprint (data/diff expected actual))))))
(deftest test-proxy-non-serializable
(testing "That proxy classes refuse serialization and deserialization"
;; Serializable listed directly in interface list:
(is (thrown? java.io.NotSerializableException
(-> (java.io.ByteArrayOutputStream.)
(java.io.ObjectOutputStream.)
(.writeObject (proxy [Object java.io.Serializable] [])))))
;; Serializable included via inheritence:
(is (thrown? java.io.NotSerializableException
(-> (java.io.ByteArrayOutputStream.)
(java.io.ObjectOutputStream.)
(.writeObject (clojure.inspector/list-model nil)))))
;; Deserialization also prohibited:
(let [java-version (System/getProperty "java.specification.version")
serialized-proxy (get serialized-proxies java-version)]
(if serialized-proxy
(is (thrown? java.io.NotSerializableException
(-> serialized-proxy
decode-base64
java.io.ByteArrayInputStream. java.io.ObjectInputStream.
.readObject)))
(println "WARNING: Missing serialized proxy for Java" java-version "in test/clojure/test_clojure/java_interop.clj")))))
(deftest test-bases
(are [x] (nil? (bases x))
java.lang.Object ;; no super classes/interfaces
java.lang.Comparable) ;; no super interfaces
(are [x y] (set/subset? (set y) (set x))
(bases java.lang.Math) [java.lang.Object]
(bases java.util.Collection) [java.lang.Iterable]
(bases java.lang.Integer) [java.lang.Number java.lang.Comparable]))
(deftest test-supers
(are [x y] (set/subset? y (set x))
(supers java.lang.Math)
#{java.lang.Object}
(supers java.lang.Integer)
#{java.lang.Number java.lang.Object
java.lang.Comparable java.io.Serializable} ))
(deftest test-proxy-super
(let [d (proxy [java.util.BitSet] []
(flip [bitIndex]
(try
(proxy-super flip bitIndex)
(catch IndexOutOfBoundsException e
(throw (IllegalArgumentException. "replaced"))))))]
;; normal call
(is (nil? (.flip d 0)))
;; exception should use proxied form and return IllegalArg
(is (thrown? IllegalArgumentException (.flip d -1)))
;; same behavior on second call
(is (thrown? IllegalArgumentException (.flip d -1)))))
;; http://dev.clojure.org/jira/browse/CLJ-1657
(deftest test-proxy-abstract-super
(let [p (proxy [java.io.Writer] [])]
(is (thrown? UnsupportedOperationException (.close p)))))
(defmacro deftest-type-array [type-array type]
`(deftest ~(symbol (str "test-" type-array))
; correct type
#_(is (= (class (first (~type-array [1 2]))) (class (~type 1))))
(deftest-type-array int-array int)
(deftest-type-array long-array long)
;todo, fix, test broken for float/double, should compare to 1.0 2.0 etc
#_(deftest-type-array float-array float)
#_(deftest-type-array double-array double)
; separate test for exceptions (doesn't work with above macro...)
(deftest test-type-array-exceptions
(are [x] (thrown? NegativeArraySizeException x)
(int-array -1)
(long-array -1)
(float-array -1)
(double-array -1) ))
(deftest test-make-array
; negative size
(is (thrown? NegativeArraySizeException (make-array Integer -1)))
(deftest test-to-array
(let [v [1 "abc" :kw \c []]
a (to-array v)]
(are [x y] (= x y)
; length
(alength a) (count v)
(defmacro test-to-passed-array-for [collection-type]
`(deftest ~(symbol (str "test-to-passed-array-for-" collection-type))
(let [string-array# (make-array String 5)
shorter# (~collection-type "1" "2" "3")
same-length# (~collection-type "1" "2" "3" "4" "5")
longer# (~collection-type "1" "2" "3" "4" "5" "6")]
(are [expected actual] (array-typed-equals expected actual)
(into-array String ["1" "2" "3" nil nil]) (.toArray shorter# string-array#)
(into-array String ["1" "2" "3" "4" "5"]) (.toArray same-length# string-array#)
(into-array String ["1" "2" "3" "4" "5" "6"]) (.toArray longer# string-array#)))))
(deftest test-into-array
; compatible types only
(is (thrown? IllegalArgumentException (into-array [1 "abc" :kw])))
(is (thrown? IllegalArgumentException (into-array [1.2 4])))
(is (thrown? IllegalArgumentException (into-array [(byte 2) (short 3)])))
(is (thrown? IllegalArgumentException (into-array Byte/TYPE [100000000000000])))
; simple case
(let [v [1 2 3 4 5]
a (into-array v)]
(are [x y] (= x y)
(alength a) (count v)
(vec a) v
(class (first a)) (class (first v)) ))
(deftest test-to-array-2d
; needs to be a collection of collection(s)
(is (thrown? Exception (to-array-2d [1 2 3])))
(deftest test-alength
(are [x] (= (alength x) 0)
(int-array 0)
(long-array 0)
(float-array 0)
(double-array 0)
(boolean-array 0)
(byte-array 0)
(char-array 0)
(short-array 0)
(make-array Integer/TYPE 0)
(to-array [])
(into-array [])
(to-array-2d []) )
(deftest test-aclone
; clone all arrays except 2D
(are [x] (and (= (alength (aclone x)) (alength x))
(= (vec (aclone x)) (vec x)))
(int-array 0)
(long-array 0)
(float-array 0)
(double-array 0)
(boolean-array 0)
(byte-array 0)
(char-array 0)
(short-array 0)
(make-array Integer/TYPE 0)
(to-array [])
(into-array [])
(deftest test-boolean
(are [x y] (and (instance? java.lang.Boolean (boolean x))
(= (boolean x) y))
nil false
false false
true true
(deftest test-char
; int -> char
(is (instance? java.lang.Character (char 65)))
(deftest test-boxing-prevention-when-compiling-statements
(is (= 1 (.get (doto (AtomicInteger. 0) inc-atomic-int))))
(is (= 1 (.get (doto (AtomicLong. 0) inc-atomic-long)))))
clojure
(ns clojure.test-clojure.java.process
(:require
[clojure.test :refer :all]
[clojure.java.process :as p]
[clojure.string :as str]))
(deftest test-stderr-redirect
;; capture to stdout and return string
(is (not (str/blank? (p/exec "bash" "-c" "ls"))))
clojure
(ns ^{:doc "Tests for clojure.core/gen-class"
:author "Stuart Halloway, Daniel Solano Gómez"}
clojure.test-clojure.genclass
(:use clojure.test clojure.test-helper)
(:require clojure.test_clojure.genclass.examples)
(:import [clojure.test_clojure.genclass.examples
ExampleClass
ExampleAnnotationClass
ProtectedFinalTester
ArrayDefInterface
ArrayGenInterface]
(deftest arg-support
(let [example (ExampleClass.)
o (Object.)]
(is (= "foo with o, o" (.foo example o o)))
(is (= "foo with o, i" (.foo example o (int 1))))
(is (thrown? java.lang.UnsupportedOperationException (.foo example o)))))
(deftest name-munging
(testing "mapping from Java fields to Clojure vars"
(is (= #'clojure.test-clojure.genclass.examples/-foo-Object-int
(get-field ExampleClass 'foo_Object_int__var)))
(is (= #'clojure.test-clojure.genclass.examples/-toString
(get-field ExampleClass 'toString__var)))))
;todo - fix this, it depends on the order of things out of a hash-map
#_(deftest test-annotations
(let [annot-class ExampleAnnotationClass
foo-method (.getDeclaredMethod annot-class "foo" (into-array [String]))]
(testing "Class annotations:"
(is (= 2 (count (.getDeclaredAnnotations annot-class))))
(testing "@Deprecated"
(let [deprecated (.getAnnotation annot-class Deprecated)]
(is deprecated)))
(testing "@Target([])"
(let [resource (.getAnnotation annot-class Target)]
(is (= 0 (count (.value resource)))))))
(testing "Method annotations:"
(testing "@Deprecated void foo(String):"
(is (= 1 (count (.getDeclaredAnnotations foo-method))))
(is (.getAnnotation foo-method Deprecated))))
(testing "Parameter annotations:"
(let [param-annots (.getParameterAnnotations foo-method)]
(is (= 1 (alength param-annots)))
(let [first-param-annots (aget param-annots 0)]
(is (= 2 (alength first-param-annots)))
(testing "void foo(@Retention(…) String)"
(let [retention (aget first-param-annots 0)]
(is (instance? Retention retention))
(= RetentionPolicy/SOURCE (.value retention))))
(testing "void foo(@Target(…) String)"
(let [target (aget first-param-annots 1)]
(is (instance? Target target))
(is (= [ElementType/TYPE ElementType/PARAMETER] (seq (.value target)))))))))))
(deftest genclass-option-validation
(is (fails-with-cause? IllegalArgumentException #"Not a valid method name: has-hyphen"
(@#'clojure.core/validate-generate-class-options {:methods '[[fine [] void] [has-hyphen [] void]]}))))
(deftest protected-final-access
(let [obj (ProtectedFinalTester.)]
(testing "Protected final method visibility"
(is (thrown? IllegalArgumentException (.findSystemClass obj "java.lang.String"))))
(testing "Allow exposition of protected final method."
(is (= String (.superFindSystemClass obj "java.lang.String"))))))
(deftest interface-array-type-hints
(let [array-types {:ints (class (int-array 0))
:bytes (class (byte-array 0))
:shorts (class (short-array 0))
:chars (class (char-array 0))
:longs (class (long-array 0))
:floats (class (float-array 0))
:doubles (class (double-array 0))
:booleans (class (boolean-array 0))
:maps (class (into-array java.util.Map []))}
array-types (assoc array-types
:maps-2d (class (into-array (:maps array-types) [])))
method-with-name (fn [name methods] (first (filter #(= name (.getName %)) methods)))
parameter-type (fn [method] (first (.getParameterTypes method)))
return-type (fn [method] (.getReturnType method))]
(testing "definterface"
(let [method-with-name #(method-with-name % (.getMethods ArrayDefInterface))]
(testing "sugar primitive array hints"
(are [name type] (= (type array-types)
(parameter-type (method-with-name name)))
"takesByteArray" :bytes
"takesCharArray" :chars
"takesShortArray" :shorts
"takesIntArray" :ints
"takesLongArray" :longs
"takesFloatArray" :floats
"takesDoubleArray" :doubles
"takesBooleanArray" :booleans))
(testing "raw primitive array hints"
(are [name type] (= (type array-types)
(return-type (method-with-name name)))
"returnsByteArray" :bytes
"returnsCharArray" :chars
"returnsShortArray" :shorts
"returnsIntArray" :ints
"returnsLongArray" :longs
"returnsFloatArray" :floats
"returnsDoubleArray" :doubles
"returnsBooleanArray" :booleans))))
(testing "gen-interface"
(let [method-with-name #(method-with-name % (.getMethods ArrayGenInterface))]
(testing "sugar primitive array hints"
(are [name type] (= (type array-types)
(parameter-type (method-with-name name)))
"takesByteArray" :bytes
"takesCharArray" :chars
"takesShortArray" :shorts
"takesIntArray" :ints
"takesLongArray" :longs
"takesFloatArray" :floats
"takesDoubleArray" :doubles
"takesBooleanArray" :booleans))
(testing "raw primitive array hints"
(are [name type] (= (type array-types)
(return-type (method-with-name name)))
"returnsByteArray" :bytes
"returnsCharArray" :chars
"returnsShortArray" :shorts
"returnsIntArray" :ints
"returnsLongArray" :longs
"returnsFloatArray" :floats
"returnsDoubleArray" :doubles
"returnsBooleanArray" :booleans))))))
(deftest gen-interface-source-file
(let [classReader (clojure.asm.ClassReader. "clojure.test_clojure.genclass.examples.ArrayGenInterface")
sourceFile (StringBuilder.)
sourceVisitor (proxy [clojure.asm.ClassVisitor] [clojure.asm.Opcodes/ASM4 nil]
(visitSource [source debug] (.append sourceFile source)))]
(.accept classReader sourceVisitor 0)
(is (= "examples.clj" (str sourceFile)))))
clojure
(ns clojure.test-clojure.data-structures
(:use clojure.test
[clojure.test.generative :exclude (is)])
(:require [clojure.test-clojure.generators :as cgen]
[clojure.data.generators :as gen]
[clojure.string :as string])
(:import [java.util Collection]))
(deftest test-equality
; nil is not equal to any other value
(are [x] (not (= nil x))
true false
0 0.0
\space
"" #""
() [] #{} {}
(lazy-seq nil) ; SVN 1292: fixed (= (lazy-seq nil) nil)
(lazy-seq ())
(lazy-seq [])
(lazy-seq {})
(lazy-seq #{})
(lazy-seq "")
(lazy-seq (into-array []))
(new Object) )
(deftest test-count
(let [EMPTY clojure.lang.PersistentQueue/EMPTY]
(are [x y] (= (count x) y)
EMPTY 0
(into EMPTY [:a :b]) 2
(-> (into EMPTY [:a :b]) pop pop) 0
nil 0
(deftest test-conj
; doesn't work on strings or arrays
(is (thrown? ClassCastException (conj "" \a)))
(is (thrown? ClassCastException (conj (into-array []) 1)))
(deftest test-peek
; doesn't work for sets and maps
(is (thrown? ClassCastException (peek #{1})))
(is (thrown? ClassCastException (peek {:a 1})))
(deftest test-pop
; doesn't work for sets and maps
(is (thrown? ClassCastException (pop #{1})))
(is (thrown? ClassCastException (pop #{:a 1})))
(deftest test-list
(are [x] (list? x)
()
'()
(list)
(list 1 2 3) )
(deftest test-find
(are [x y] (= x y)
(find {} :a) nil
(deftest test-contains?
; contains? is designed to work preferably on maps and sets
(are [x y] (= x y)
(contains? {} :a) false
(contains? {} nil) false
(deftest test-keys
(are [x y] (= x y) ; other than map data structures
(keys ()) nil
(keys []) nil
(keys #{}) nil
(keys "") nil )
(deftest test-vals
(are [x y] (= x y) ; other than map data structures
(vals ()) nil
(vals []) nil
(vals #{}) nil
(vals "") nil )
(deftest test-sorted-map-keys
(is (thrown? ClassCastException (sorted-map () 1)))
(is (thrown? ClassCastException (sorted-map #{} 1)))
(is (thrown? ClassCastException (sorted-map {} 1)))
(deftest test-key
(are [x] (= (key (first (hash-map x :value))) 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} ))
(deftest test-val
(are [x] (= (val (first (hash-map :key 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} ))
(deftest test-get
(let [m {:a 1, :b 2, :c {:d 3, :e 4}, :f nil, :g false, nil {:h 5}}]
(is (thrown? IllegalArgumentException (get-in {:a 1} 5)))
(are [x y] (= x y)
(get m :a) 1
(get m :e) nil
(get m :e 0) 0
(get m nil) {:h 5}
(get m :b 0) 2
(get m :f 0) nil
(deftest test-nested-map-destructuring
(let [sample-map {:a 1 :b {:a 2}}
{ao1 :a {ai1 :a} :b} sample-map
{ao2 :a {ai2 :a :as m1} :b :as m2} sample-map
{ao3 :a {ai3 :a :as m} :b :as m} sample-map
{{ai4 :a :as m} :b ao4 :a :as m} sample-map]
(are [i o] (and (= i 2)
(= o 1))
ai1 ao1
ai2 ao2
ai3 ao3
ai4 ao4)))
(deftest test-map-entry?
(testing "map-entry? = false"
(are [entry]
(false? (map-entry? entry))
nil 5 #{1 2} '(1 2) {:a 1} [] [0] [1 2 3]))
(testing "map-entry? = true"
(are [entry]
(true? (map-entry? entry))
(first (doto (java.util.HashMap.) (.put "x" 1))))))
(deftest test-hash-set
(are [x] (set? x)
#{}
#{1 2}
(hash-set)
(hash-set 1 2) )
(deftest test-sorted-set
; only compatible types can be used
(is (thrown? ClassCastException (sorted-set 1 "a")))
(is (thrown? ClassCastException (sorted-set '(1 2) [3 4])))
(deftest test-sorted-set-by
; only compatible types can be used
; NB: not a ClassCastException, but a RuntimeException is thrown,
; requires discussion on whether this should be symmetric with test-sorted-set
(is (thrown? Exception (sorted-set-by < 1 "a")))
(is (thrown? Exception (sorted-set-by < '(1 2) [3 4])))
(deftest test-set
; set?
(are [x] (set? (set x))
() '(1 2)
[] [1 2]
#{} #{1 2}
{} {:a 1 :b 2}
(into-array []) (into-array [1 2])
"" "abc" )
(deftest test-disj
; doesn't work on lists, vectors or maps
(is (thrown? ClassCastException (disj '(1 2) 1)))
(is (thrown? ClassCastException (disj [1 2] 1)))
(is (thrown? ClassCastException (disj {:a 1} :a)))
(deftest test-queues
(let [EMPTY clojure.lang.PersistentQueue/EMPTY]
(are [x y] (= x y)
EMPTY EMPTY
(into EMPTY (range 50)) (into EMPTY (range 50))
(conj EMPTY (Long. -1)) (conj EMPTY (Integer. -1))
(hash (conj EMPTY (Long. -1))) (hash (conj EMPTY (Integer. -1)))
(hash [1 2 3]) (hash (conj EMPTY 1 2 3))
(range 5) (into EMPTY (range 5))
(range 1 6) (-> EMPTY
(into (range 6))
pop))
(are [x y] (not= x y)
(range 5) (into EMPTY (range 6))
(range 6) (into EMPTY (range 5))
(range 0 6) (-> EMPTY
(into (range 6))
pop)
(range 1 6) (-> EMPTY
(into (range 7))
pop))))
(deftest test-duplicates
(let [equal-sets-incl-meta (fn [s1 s2]
(and (= s1 s2)
(let [ss1 (sort s1)
ss2 (sort s2)]
(every? identity
(map #(and (= %1 %2)
(= (meta %1) (meta %2)))
ss1 ss2)))))
all-equal-sets-incl-meta (fn [& ss]
(every? (fn [[s1 s2]]
(equal-sets-incl-meta s1 s2))
(partition 2 1 ss)))
equal-maps-incl-meta (fn [m1 m2]
(and (= m1 m2)
(equal-sets-incl-meta (set (keys m1))
(set (keys m2)))
(every? #(= (meta (m1 %)) (meta (m2 %)))
(keys m1))))
all-equal-maps-incl-meta (fn [& ms]
(every? (fn [[m1 m2]]
(equal-maps-incl-meta m1 m2))
(partition 2 1 ms)))
cmp-first #(> (first %1) (first %2))
x1 (with-meta [1] {:me "x"})
y2 (with-meta [2] {:me "y"})
z3a (with-meta [3] {:me "z3a"})
z3b (with-meta [3] {:me "z3b"})
v4a (with-meta [4] {:me "v4a"})
v4b (with-meta [4] {:me "v4b"})
v4c (with-meta [4] {:me "v4c"})
w5a (with-meta [5] {:me "w5a"})
w5b (with-meta [5] {:me "w5b"})
w5c (with-meta [5] {:me "w5c"})]
(deftest test-array-map-arity
(is (thrown? IllegalArgumentException
(array-map 1 2 3))))
(deftest test-assoc
(are [x y] (= x y)
[4] (assoc [] 0 4)
[5 -7] (assoc [] 0 5 1 -7)
{:a 1} (assoc {} :a 1)
{nil 1} (assoc {} nil 1)
{:a 2 :b -2} (assoc {} :b -2 :a 2))
(is (thrown? IllegalArgumentException (assoc [] 0 5 1)))
(is (thrown? IllegalArgumentException (assoc {} :b -2 :a))))
(deftest ordered-collection-equality-test
(let [empty-colls [ []
'()
(lazy-seq)
clojure.lang.PersistentQueue/EMPTY
(vector-of :long) ]]
(doseq [c1 empty-colls, c2 empty-colls]
(is-same-collection c1 c2)))
(let [colls1 [ [-3 :a "7th"]
'(-3 :a "7th")
(lazy-seq (cons -3
(lazy-seq (cons :a
(lazy-seq (cons "7th" nil))))))
(into clojure.lang.PersistentQueue/EMPTY
[-3 :a "7th"])
(sequence (map identity) [-3 :a "7th"]) ]]
(doseq [c1 colls1, c2 colls1]
(is-same-collection c1 c2)))
(let [long-colls [ [2 3 4]
'(2 3 4)
(vector-of :long 2 3 4)
(seq (vector-of :long 2 3 4))
(range 2 5)]]
(doseq [c1 long-colls, c2 long-colls]
(is-same-collection c1 c2))))
(deftest set-equality-test
(let [empty-sets [ #{}
(hash-set)
(sorted-set)
(sorted-set-by case-indendent-string-cmp) ]]
(doseq [s1 empty-sets, s2 empty-sets]
(is-same-collection s1 s2)))
(let [sets1 [ #{"Banana" "apple" "7th"}
(hash-set "Banana" "apple" "7th")
(sorted-set "Banana" "apple" "7th")
(sorted-set-by case-indendent-string-cmp "Banana" "apple" "7th") ]]
(doseq [s1 sets1, s2 sets1]
(is-same-collection s1 s2))))
(deftest map-equality-test
(let [empty-maps [ {}
(hash-map)
(array-map)
(sorted-map)
(sorted-map-by case-indendent-string-cmp) ]]
(doseq [m1 empty-maps, m2 empty-maps]
(is-same-collection m1 m2)))
(let [maps1 [ {"Banana" "like", "apple" "love", "7th" "indifferent"}
(hash-map "Banana" "like", "apple" "love", "7th" "indifferent")
(array-map "Banana" "like", "apple" "love", "7th" "indifferent")
(sorted-map "Banana" "like", "apple" "love", "7th" "indifferent")
(sorted-map-by case-indendent-string-cmp
"Banana" "like", "apple" "love", "7th" "indifferent") ]]
(doseq [m1 maps1, m2 maps1]
(is-same-collection m1 m2))))
(deftest ireduce-reduced
(let [f (fn [_ a] (if (= a 5) (reduced "foo")))]
(is (= "foo" (.reduce ^clojure.lang.IReduce (list 1 2 3 4 5) f)))
(is (= "foo" (.reduce ^clojure.lang.IReduce (seq (long-array [1 2 3 4 5])) f)))))
(deftest test-seq-iter-match
(let [maps (mapcat #(vector (apply array-map %)
(apply hash-map %)
(apply sorted-map %))
[[] [nil 1] [nil 1 2 3] [1 2 3 4]])]
(doseq [m maps]
(seq-iter-match m m)
(seq-iter-match (keys m) (keys m))
(seq-iter-match (vals m) (vals m))
(seq-iter-match (rest (keys m)) (rest (keys m)))
(seq-iter-match (rest (vals m)) (rest (vals m))))))
(deftest record-hashing
(let [r (->Rec 1 1)
_ (hash r)
r2 (assoc r :c 2)]
(is (= (hash (->Rec 1 1)) (hash r)))
(is (= (hash r) (hash (with-meta r {:foo 2}))))
(is (not= (hash (->Rec 1 1)) (hash (assoc (->Rec 1 1) :a 2))))
(is (not= (hash (->Rec 1 1)) (hash r2)))
(is (not= (hash (->Rec 1 1)) (hash (assoc r :a 2))))
(is (= (hash (->Rec 1 1)) (hash (assoc r :a 1))))
(is (= (hash (->Rec 1 1)) (hash (dissoc r2 :c))))
(is (= (hash (->Rec 1 1)) (hash (dissoc (assoc r :c 1) :c))))))
(deftest singleton-map-in-destructure-context
(let [sample-map {:a 1 :b 2}
{:keys [a] :as m1} (list sample-map)]
(is (= m1 sample-map))
(is (= a 1))))
(deftest trailing-map-destructuring
(let [sample-map {:a 1 :b 2}
add (fn [& {:keys [a b]}] (+ a b))
addn (fn [n & {:keys [a b]}] (+ n a b))]
(testing "that kwargs are applied properly given a map in place of the key/val pairs"
(is (= 3 (add :a 1 :b 2)))
(is (= 3 (add {:a 1 :b 2})))
(is (= 13 (addn 10 :a 1 :b 2)))
(is (= 13 (addn 10 {:a 1 :b 2})))
(is (= 103 ((partial addn 100) :a 1 {:b 2})))
(is (= 103 ((partial addn 100 :a 1) {:b 2})))
(is (= 107 ((partial addn 100 :a 1) {:a 5 :b 2}))))
(testing "built maps"
(let [{:as m1} (list :a 1 :b 2)
{:as m2} (list :a 1 :b 2 {:c 3})
{:as m3} (list :a 1 :b 2 {:a 0})
{:keys [a4] :as m4} (list nil)]
(= m1 {:a 1 :b 2})
(= m2 {:a 1 :b 2 :c 3})
(= m3 {:a 0 :b 2})
(= m1 (seq-to-map-for-destructuring (list :a 1 :b 2)))
(= m2 (seq-to-map-for-destructuring (list :a 1 :b 2 {:c 3})))
(= m3 (seq-to-map-for-destructuring (list :a 1 :b 2 {:a 0})))
(= a4 nil)))))
clojure
(ns clojure.test-clojure.compilation
(:import (clojure.lang Compiler Compiler$CompilerException))
(:require [clojure.test.generative :refer (defspec)]
[clojure.data.generators :as gen]
[clojure.test-clojure.compilation.line-number-examples :as line])
(:use clojure.test
[clojure.test-helper :only (should-not-reflect should-print-err-message)]))
(deftest test-compiler-metadata
(let [m (meta #'when)]
(are [x y] (= x y)
(list? (:arglists m)) true
(> (count (:arglists m)) 0) true
(deftest test-embedded-constants
(testing "Embedded constants"
(is (eval `(= Boolean/TYPE ~Boolean/TYPE)))
(is (eval `(= Byte/TYPE ~Byte/TYPE)))
(is (eval `(= Character/TYPE ~Character/TYPE)))
(is (eval `(= Double/TYPE ~Double/TYPE)))
(is (eval `(= Float/TYPE ~Float/TYPE)))
(is (eval `(= Integer/TYPE ~Integer/TYPE)))
(is (eval `(= Long/TYPE ~Long/TYPE)))
(is (eval `(= Short/TYPE ~Short/TYPE)))))
(deftest test-compiler-resolution
(testing "resolve nonexistent class create should return nil (assembla #262)"
(is (nil? (resolve 'NonExistentClass.))))
(testing "resolve nonexistent class should return nil"
(is (nil? (resolve 'NonExistentClass.Name)))))
(deftest test-no-recur-across-try
(testing "don't recur to function from inside try"
(is (thrown? Compiler$CompilerException
(eval '(fn [x] (try (recur 1)))))))
(testing "don't recur to loop from inside try"
(is (thrown? Compiler$CompilerException
(eval '(loop [x 5]
(try (recur 1)))))))
(testing "don't recur to loop from inside of catch inside of try"
(is (thrown? Compiler$CompilerException
(eval '(loop [x 5]
(try
(catch Exception e
(recur 1))))))))
(testing "don't recur to loop from inside of finally inside of try"
(is (thrown? Compiler$CompilerException
(eval '(loop [x 5]
(try
(finally
(recur 1))))))))
(testing "don't get confused about what the recur is targeting"
(is (thrown? Compiler$CompilerException
(eval '(loop [x 5]
(try (fn [x]) (recur 1)))))))
(testing "don't allow recur across binding"
(is (thrown? Compiler$CompilerException
(eval '(fn [x] (binding [+ *] (recur 1)))))))
(testing "allow loop/recur inside try"
(is (= 0 (eval '(try (loop [x 3]
(if (zero? x) x (recur (dec x)))))))))
(testing "allow loop/recur fully inside catch"
(is (= 3 (eval '(try
(throw (Exception.))
(catch Exception e
(loop [x 0]
(if (< x 3) (recur (inc x)) x))))))))
(testing "allow loop/recur fully inside finally"
(is (= "012" (eval '(with-out-str
(try
:return-val-discarded-because-of-with-out-str
(finally (loop [x 0]
(when (< x 3)
(print x)
(recur (inc x)))))))))))
(testing "allow fn/recur inside try"
(is (= 0 (eval '(try
((fn [x]
(if (zero? x)
x
(recur (dec x))))
3)))))))
;; disabled until build box can call java from mvn
#_(deftest test-numeric-dispatch
(is (= "(int, int)" (TestDispatch/someMethod (int 1) (int 1))))
(is (= "(int, long)" (TestDispatch/someMethod (int 1) (long 1))))
(is (= "(long, long)" (TestDispatch/someMethod (long 1) (long 1)))))
(deftest test-CLJ-671-regression
(testing "that the presence of hints does not cause the compiler to infinitely loop"
(letfn [(gcd [x y]
(loop [x (long x) y (long y)]
(if (== y 0)
x
(recur y ^Long(rem x y)))))]
(is (= 4 (gcd 8 100))))))
(deftest recognize-hinted-arg-vector
(should-not-reflect #(.substring (clojure.test-clojure.compilation/hinted) 0))
(should-not-reflect #(.floatValue (clojure.test-clojure.compilation/hinted "arg")))
(should-not-reflect #(.size (clojure.test-clojure.compilation/hinted :many :rest :args :here))))
(deftest CLJ-1232-qualify-hints
(let [arglists (-> #'clojure.test-clojure.compilation/hinted meta :arglists)]
(is (= 'java.lang.String (-> arglists first meta :tag)))
(is (= 'java.lang.Integer (-> arglists second meta :tag)))))
(deftest CLJ-1232-return-type-not-imported
(is (thrown-with-cause-msg? Compiler$CompilerException #"Unable to resolve classname: Closeable"
(eval '(defn a ^Closeable []))))
(is (thrown-with-cause-msg? Compiler$CompilerException #"Unable to resolve classname: Closeable"
(eval '(defn a (^Closeable []))))))
(deftest calls-use-arg-vector-hint
(should-not-reflect #(.floatValue (clojure.test-clojure.compilation/hinting-conflict)))
(should-print-err-message #"(?s)Reflection warning.*"
#(.substring (clojure.test-clojure.compilation/hinting-conflict) 0)))
(deftest deref-uses-var-tag
(should-not-reflect #(.substring clojure.test-clojure.compilation/hinting-conflict 0))
(should-print-err-message #"(?s)Reflection warning.*"
#(.floatValue clojure.test-clojure.compilation/hinting-conflict)))
(deftest legacy-call-hint
(should-not-reflect #(.substring (clojure.test-clojure.compilation/legacy-hinting) 0)))
(deftest hinted-protocol-arg-vector
(should-not-reflect #(.substring (clojure.test-clojure.compilation/hintedp "") 0))
(should-not-reflect #(.floatValue (clojure.test-clojure.compilation/hintedp :a :b))))
(deftest primitive-return-decl
(should-not-reflect #(loop [k 5] (recur (clojure.test-clojure.compilation/primfn))))
(should-not-reflect #(loop [k 5.0] (recur (clojure.test-clojure.compilation/primfn 0))))
#_(deftest CLJ-1154-use-out-after-compile
;; This test creates a dummy file to compile, sets up a dummy
;; compiled output directory, and a dummy output stream, and
;; verifies the stream is still usable after compiling.
(spit "test/dummy.clj" "(ns dummy)")
(try
(let [compile-path (System/getProperty "clojure.compile.path")
tmp (java.io.File. "tmp")
new-out (java.io.OutputStreamWriter. (java.io.ByteArrayOutputStream.))]
(binding [clojure.core/*out* new-out]
(try
(.mkdir tmp)
(System/setProperty "clojure.compile.path" "tmp")
(clojure.lang.Compile/main (into-array ["dummy"]))
(println "this should still work without throwing an exception" )
(finally
(if compile-path
(System/setProperty "clojure.compile.path" compile-path)
(System/clearProperty "clojure.compile.path"))
(doseq [f (.listFiles tmp)]
(.delete f))
(.delete tmp)))))
(finally
(doseq [f (.listFiles (java.io.File. "test"))
:when (re-find #"dummy.clj" (str f))]
(.delete f)))))
(deftest CLJ-1184-do-in-non-list-test
(testing "do in a vector throws an exception"
(is (thrown? Compiler$CompilerException
(eval '[do 1 2 3]))))
(testing "do in a set throws an exception"
(is (thrown? Compiler$CompilerException
(eval '#{do}))))
(deftest test-fnexpr-type-hint
(testing "CLJ-1378: FnExpr should be allowed to override its reported class with a type hint."
(is (thrown? Compiler$CompilerException
(load-string "(.submit (java.util.concurrent.Executors/newCachedThreadPool) #())")))
(is (try (load-string "(.submit (java.util.concurrent.Executors/newCachedThreadPool) ^Runnable #())")
(catch Compiler$CompilerException e nil)))))
(defn ^{:tag 'long} hinted-primfn [^long x] x)
(defn unhinted-primfn [^long x] x)
(deftest CLJ-1533-primitive-functions-lose-tag
(should-not-reflect #(Math/abs (clojure.test-clojure.compilation/hinted-primfn 1)))
(should-not-reflect #(Math/abs ^long (clojure.test-clojure.compilation/unhinted-primfn 1))))
(deftest test-compiler-line-numbers
(let [fails-on-line-number? (fn [expected function]
(try
(function)
nil
(catch Throwable t
(let [frames (filter #(= "line_number_examples.clj" (.getFileName %))
(.getStackTrace t))
_ (if (zero? (count frames))
(.printStackTrace t)
)
actual (.getLineNumber ^StackTraceElement (first frames))]
(= expected actual)))))]
(is (fails-on-line-number? 13 line/instance-field))
(is (fails-on-line-number? 19 line/instance-field-reflected))
(is (fails-on-line-number? 25 line/instance-field-unboxed))
(is (fails-on-line-number? 32 line/instance-field-assign))
(is (fails-on-line-number? 40 line/instance-field-assign-reflected))
(is (fails-on-line-number? 47 line/static-field-assign))
(is (fails-on-line-number? 54 line/instance-method))
(is (fails-on-line-number? 61 line/instance-method-reflected))
(is (fails-on-line-number? 68 line/instance-method-unboxed))
(is (fails-on-line-number? 74 line/static-method))
(is (fails-on-line-number? 80 line/static-method-reflected))
(is (fails-on-line-number? 86 line/static-method-unboxed))
(is (fails-on-line-number? 92 line/invoke))
(is (fails-on-line-number? 101 line/threading))
(is (fails-on-line-number? 112 line/keyword-invoke))
(is (fails-on-line-number? 119 line/invoke-cast))))
(deftest CLJ-979
(is (= clojure.test_clojure.compilation.examples.X
(class (clojure.test-clojure.compilation.examples/->X))))
(is (.b (clojure.test_clojure.compilation.Y. 1)))
(is (= clojure.test_clojure.compilation.examples.T
(class (clojure.test_clojure.compilation.examples.T.))
(class (clojure.test-clojure.compilation.examples/->T)))))
(deftest clj-1208
;; clojure.test-clojure.compilation.load-ns has not been loaded
;; so this would fail if the deftype didn't load it in its static
;; initializer as the implementation of f requires a var from
;; that namespace
(is (= 1 (.f (clojure.test_clojure.compilation.load_ns.x.)))))
(deftest clj-1568
(let [compiler-fails-at?
(fn [row col source]
(let [path (name (gensym "clj-1568.example-"))]
(try
(Compiler/load (java.io.StringReader. source) path "clj-1568.example")
nil
(catch Compiler$CompilerException e
(let [data (ex-data e)]
(= [path row col]
[(:clojure.error/source data) (:clojure.error/line data) (:clojure.error/column data)]))))))]
(testing "with error in the initial form"
(are [row col source] (compiler-fails-at? row col source)
;; note that the spacing of the following string is important
1 4 " (.foo nil)"
2 18 "
(/ 1 0)"))
(testing "with error in an non-initial form"
(are [row col source] (compiler-fails-at? row col source)
;; note that the spacing of the following string is important
3 18 "(:foo {})
(deftest clj-1399
;; throws an exception on failure
(is (eval `(fn [] ~(CLJ1399. 1)))))
(deftest CLJ-1250-this-clearing
(testing "clearing during try/catch/finally"
(let [closed-over-in-catch (let [x :foo]
(fn []
(try
(throw (Exception. "boom"))
(catch Exception e
x)))) ;; x should remain accessible to the fn
(deftest CLJ-1586-lazyseq-literals-preserve-metadata
(should-not-reflect (eval (list '.substring (with-meta (concat '(identity) '("foo")) {:tag 'String}) 0))))
(deftest CLJ-1456-compiler-error-on-incorrect-number-of-parameters-to-throw
(is (thrown? RuntimeException (eval '(defn foo [] (throw)))))
(is (thrown? RuntimeException (eval '(defn foo [] (throw RuntimeException any-symbol)))))
(is (thrown? RuntimeException (eval '(defn foo [] (throw (RuntimeException.) any-symbol)))))
(is (var? (eval '(defn foo [] (throw (IllegalArgumentException.)))))))
(deftest clj-1809
(is (eval `(fn [y#]
(try
(finally
(let [z# y#])))))))
;; See CLJ-1846
(deftest incorrect-primitive-type-hint-throws
;; invalid primitive type hint
(is (thrown-with-cause-msg? Compiler$CompilerException #"Cannot coerce long to int"
(load-string "(defn returns-long ^long [] 1) (Integer/bitCount ^int (returns-long))")))
;; correct casting instead
(is (= 1 (load-string "(defn returns-long ^long [] 1) (Integer/bitCount (int (returns-long)))"))))
;; See CLJ-1825
(def zf (fn rf [x] (lazy-seq (cons x (rf x)))))
(deftest test-anon-recursive-fn
(is (= [0 0] (take 2 ((fn rf [x] (lazy-seq (cons x (rf x)))) 0))))
(is (= [0 0] (take 2 (zf 0)))))
;; See CLJ-1845
(deftest direct-linking-for-load
(let [called? (atom nil)
logger (fn [& args]
(reset! called? true)
nil)]
(with-redefs [load logger]
;; doesn't actually load clojure.repl, but should
;; eventually call `load` and reset called?.
(require 'clojure.repl :reload))
(is @called?)))
(deftest clj-1714
(testing "CLJ-1714 Classes shouldn't have their static initialisers called simply by type hinting or importing"
;; ClassWithFailingStaticInitialiser will throw if its static initialiser is called
(is (eval '(fn [^compilation.ClassWithFailingStaticInitialiser c])))
(is (eval '(import (compilation ClassWithFailingStaticInitialiser))))))
(deftest CLJ-2284
(testing "CLJ-2284 Can call static methods on interfaces"
(is (= 42 (compilation.JDK8InterfaceMethods/staticMethod0 42)))
(is (= "test" (compilation.JDK8InterfaceMethods/staticMethod1 "test")))
(is (= 1 (if (compilation.JDK8InterfaceMethods/staticMethod2 true) 1 2)))))
(deftest CLJ-2580
(testing "CLJ-2580 Correctly calculate exit branches of case"
(is (zero? (let [d (case nil :x nil 0)] d)))
(is (nil? (let [d (case nil :x 0 nil)] d)))))
clojure
(ns clojure.test-clojure.clojure-walk
(:require [clojure.walk :as w])
(:use clojure.test))
(deftest t-prewalk-replace
(is (= (w/prewalk-replace {:a :b} [:a {:a :a} (list 3 :c :a)])
[:b {:b :b} (list 3 :c :b)])))
(deftest t-postwalk-replace
(is (= (w/postwalk-replace {:a :b} [:a {:a :a} (list 3 :c :a)])
[:b {:b :b} (list 3 :c :b)])))
(deftest t-stringify-keys
(is (= (w/stringify-keys {:a 1, nil {:b 2 :c 3}, :d 4})
{"a" 1, nil {"b" 2 "c" 3}, "d" 4})))
(deftest t-prewalk-order
(is (= (let [a (atom [])]
(w/prewalk (fn [form] (swap! a conj form) form)
[1 2 {:a 3} (list 4 [5])])
@a)
[[1 2 {:a 3} (list 4 [5])]
1 2 {:a 3} [:a 3] :a 3 (list 4 [5])
4 [5] 5])))
(deftest t-postwalk-order
(is (= (let [a (atom [])]
(w/postwalk (fn [form] (swap! a conj form) form)
[1 2 {:a 3} (list 4 [5])])
@a)
[1 2
:a 3 [:a 3] {:a 3}
4 5 [5] (list 4 [5])
[1 2 {:a 3} (list 4 [5])]])))
(deftest walk
"Checks that walk returns the correct result and type of collection"
(let [colls ['(1 2 3)
[1 2 3]
#{1 2 3}
(sorted-set-by > 1 2 3)
{:a 1, :b 2, :c 3}
(sorted-map-by > 1 10, 2 20, 3 30)
(->Foo 1 2 3)
(map->Foo {:a 1 :b 2 :c 3 :extra 4})]]
(doseq [c colls]
(let [walked (w/walk identity identity c)]
(is (= c walked))
;;(is (= (type c) (type walked)))
(if (map? c)
(is (= (w/walk #(update-in % [1] inc) #(reduce + (vals %)) c)
(reduce + (map (comp inc val) c))))
(is (= (w/walk inc #(reduce + %) c)
(reduce + (map inc c)))))
(when (or (instance? clojure.lang.PersistentTreeMap c)
(instance? clojure.lang.PersistentTreeSet c))
(is (= (.comparator c) (.comparator walked))))))))
(deftest walk-mapentry
"Checks that walk preserves the MapEntry type. See CLJ-2031."
(let [coll [:html {:a ["b" 1]} ""]
f (fn [e] (if (and (vector? e) (not (map-entry? e))) (apply list e) e))]
(is (= (list :html {:a (list "b" 1)} "") (w/postwalk f coll)))))
clj-kondo/clj-kondo
(ns deftest
(:require [clojure.test :refer [deftest is are #?(:cljs async)]])
(:import clojure.lang.ExceptionInfo))
(deftest are-test
(are [?a ?b]
(is (= ?a (dec ?b)))
1 2
10 11
14 15))
(deftest missing-test-assertion-false-positive
(are [v expected?] (expected? (contains? #{:bar :baz} v))
:foo false?
:bar true?
:baz true?))
(deftest thrown-test
(is (thrown? #?(:clj Exception :cljs js/Error) :foo))
(are [x] (thrown? #?(:clj Exception :cljs js/Error) x) :foo))
(deftest thown-with-msg-test
(is (thrown-with-msg?
ExceptionInfo #"uh oh"
(throw (ex-info "uh oh" {}))))
(is (thrown? ExceptionInfo (throw (ex-info "uh oh" {})))))
clj-kondo/clj-kondo
(ns redefined-deftest
(:require [clojure.test :refer [deftest]]))
(deftest)
(deftest foo)
(deftest foo) ;; <- redefined test warning
nubank/matcher-combinators
(require '[clojure.test :refer [deftest is]]
'[matcher-combinators.test] ;; adds support for `match?` and `thrown-match?` in `is` expressions
'[matcher-combinators.matchers :as m])
(deftest test-matching-with-explict-matchers
(is (match? (m/equals 37) (+ 29 8)))
(is (match? (m/regex #"fox") "The quick brown fox jumps over the lazy dog")))
(deftest test-matching-scalars
;; most scalar values are interpreted as an `equals` matcher
(is (match? 37 (+ 29 8)))
(is (match? "this string" (str "this" " " "string")))
(is (match? :this/keyword (keyword "this" "keyword")))
;; regular expressions are handled specially
(is (match? #"fox" "The quick brown fox jumps over the lazy dog")))
(deftest test-matching-sequences
;; A sequence is interpreted as an `equals` matcher, which specifies
;; count and order of matching elements. The elements, themselves,
;; are matched based on their types.
(is (match? [1 3] [1 3]))
(is (match? [1 odd?] [1 3]))
(is (match? [#"red" #"violet"] ["Roses are red" "Violets are ... violet"]))
(deftest test-matching-sets
;; A set is also interpreted as an `equals` matcher.
(is (match? #{1 2 3} #{3 2 1}))
(is (match? #{odd? even?} #{1 2}))
;; use m/set-equals to repeat predicates
(is (match? (m/set-equals [odd? odd? even?]) #{1 2 3})))
(deftest test-matching-maps
;; A map is interpreted as an `embeds` matcher, which ignores
;; un-specified keys
(is (match? {:name/first "Alfredo"}
{:name/first "Alfredo"
:name/last "da Rocha Viana"
:name/suffix "Jr."})))
(deftest test-matching-nested-datastructures
;; Maps, sequences, and sets follow the same semantics whether at
;; the top level or nested within a structure.
(is (match? {:band/members [{:name/first "Alfredo"}
{:name/first "Benedito"}]}
{:band/members [{:name/first "Alfredo"
:name/last "da Rocha Viana"
:name/suffix "Jr."}
{:name/first "Benedito"
:name/last "Lacerda"}]
:band/recordings []})))
(deftest exception-matching
(is (thrown-match? clojure.lang.ExceptionInfo
{:foo 1}
(throw (ex-info "Boom!" {:foo 1 :bar 2})))))
borkdude/deflet
(ns playwright.example
(:require ["playwright$default" :refer [chromium]]
[clojure.test :as t :refer [deftest is async]]
[borkdude.deflet :refer [defletp defp]]
[promesa.core :as p]))
(deftest my-test
(defletp
(defp browser-ref (atom nil))
(async
done
(->
(defletp
;; Let the story begin!
(defp browser (.launch chromium #js {:headless headless}))
(reset! browser-ref browser)
(defp page (.newPage browser))
(.goto page "https://clojure.org" #js{:waitUntil "networkidle"})
(defp h2 (p/-> (.locator page "h2")
(.allInnerTexts)
first))
(is (= h2 "The Clojure Programming Language")))
(p/finally #(do (.close @browser-ref)
(done)))))))
walmartlabs/test-reporting
(ns user
(:require
[clojure.test :refer [is deftest run-tests]]
[com.walmartlabs.test-reporting :refer [reporting]]))
(deftest example-single-symbol-reporting
(let [response {:status 404 :body "NOT FOUND"}]
(reporting response
(is (= 200 (:status response))))))