Back
is (clj)
(source)macro
(is form)
(is form msg)
Generic assertion macro. 'form' is any predicate test.
'msg' is an optional message to attach to the assertion.
Example: (is (= 4 (+ 2 2)) "Two plus two should be 4")
Special forms:
(is (thrown? c body)) checks that an instance of c is thrown from
body, fails if not; then returns the thing thrown.
(is (thrown-with-msg? c re body)) checks that an instance of c is
thrown AND that the message on the exception matches (with
re-find) the regular expression re.
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]))
(defmacro fbind [source-gen f]
`(gen/fmap
(fn [s#]
{:desc (list '~f (:name s#))
:seq (partial ~f (:val s#))
:xf (~f (:val s#))})
~source-gen))
(def gen-take (fbind (literal gen/s-pos-int) take))
(def gen-drop (fbind (literal gen/pos-int) drop))
(def gen-drop-while (fbind gen-predfn drop-while))
(def gen-map (fbind gen-mapfn map))
(def gen-mapcat (fbind gen-mapcatfn mapcat))
(def gen-filter (fbind gen-predfn filter))
(def gen-remove (fbind gen-predfn remove))
(def gen-keep (fbind gen-predfn keep))
(def gen-partition-all (fbind (literal gen/s-pos-int) partition-all))
(def gen-partition-by (fbind gen-predfn partition-by))
(def gen-take-while (fbind gen-predfn take-while))
(def gen-take-nth (fbind (literal gen/s-pos-int) take-nth))
(def gen-keep-indexed (fbind gen-indexedfn keep-indexed))
(def gen-map-indexed (fbind gen-indexedfn map-indexed))
(def gen-replace (fbind (literal (gen/return (hash-map (range 100) (range 1 100)))) replace))
(def gen-distinct (gen/return {:desc 'distinct :seq (partial distinct) :xf (distinct)}))
(def gen-dedupe (gen/return {:desc 'dedupe :seq (partial dedupe) :xf (dedupe)}))
(def gen-interpose (fbind (literal gen/s-pos-int) interpose))
(def gen-action
(gen/one-of [gen-take gen-drop gen-map gen-mapcat
gen-filter gen-remove gen-keep
gen-partition-all gen-partition-by gen-take-while
gen-take-nth gen-drop-while
gen-keep-indexed gen-map-indexed
gen-distinct gen-dedupe gen-interpose]))
(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-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-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 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))))))
clojure
(ns clojure.test-clojure.server
(:import java.util.Random)
(:require [clojure.test :refer :all])
(:require [clojure.core.server :as s]))
(defn check-invalid-opts
[opts msg]
(try
(#'clojure.core.server/validate-opts opts)
(is nil)
(catch Exception e
(is (= (ex-data e) opts))
(is (= msg (.getMessage e))))))
(defn create-random-thread
[]
(Thread.
(fn []
(let [random (new Random)]
(while (not (.isInterrupted (Thread/currentThread)))
(System/setProperty (Integer/toString (.nextInt random)) (Integer/toString (.nextInt random))))))))
(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 +))))
(is (= 4500000
(->> (range 100000)
(mapcat (fn [_] (java.util.ArrayList. (range 10))))
(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))))
(is (not (.equals (lazy-seq [3]) (lazy-seq [3N]))))
(lazy-seq [3]) [3N]
(lazy-seq (list 1 2)) '(1 2)
(lazy-seq [1 2]) '(1 2)
(lazy-seq (sorted-set 1 2)) '(1 2)
(lazy-seq (sorted-map :a 1 :b 2)) '([:a 1] [:b 2])
(lazy-seq "abc") '(\a \b \c)
(lazy-seq (into-array [1 2])) '(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)
(seq [3]) [3N]
(seq (list 1 2)) '(1 2)
(seq [1 2]) '(1 2)
(seq (sorted-set 1 2)) '(1 2)
(seq (sorted-map :a 1 :b 2)) '([:a 1] [:b 2])
(seq "abc") '(\a \b \c)
(seq (into-array [1 2])) '(1 2) ))
(deftest test-cons
(is (thrown? IllegalArgumentException (cons 1 2)))
(are [x y] (= x y)
(cons 1 nil) '(1)
(cons nil 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-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
; list
(first ()) nil
(first '(1)) 1
(first '(1 2 3)) 1
(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
; list
(next ()) nil
(next '(1)) nil
(next '(1 2 3)) '(2 3)
(next (to-array [nil])) nil
(next (to-array [1 nil])) '(nil)
;(next (to-array [1 (into-array [])])) (list (into-array []))
(next (to-array [nil 2])) '(2)
(next (to-array [(into-array [])])) nil
(next (to-array [(into-array []) nil])) '(nil)
(next (to-array [(into-array []) 2 nil])) '(2 nil) ))
; list
(last ()) nil
(last '(1)) 1
(last '(1 2 3)) 3
;; (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)))
; out of bounds
(is (thrown? IndexOutOfBoundsException (nth '() 0)))
(is (thrown? IndexOutOfBoundsException (nth '(1 2 3) 5)))
(is (thrown? IndexOutOfBoundsException (nth '() -1)))
(is (thrown? IndexOutOfBoundsException (nth '(1 2 3) -1)))
(is (thrown? IndexOutOfBoundsException (nth [] 0)))
(is (thrown? IndexOutOfBoundsException (nth [1 2 3] 5)))
(is (thrown? IndexOutOfBoundsException (nth [] -1)))
(is (thrown? IndexOutOfBoundsException (nth [1 2 3] -1))) ; ???
(is (thrown? IndexOutOfBoundsException (nth (into-array []) 0)))
(is (thrown? IndexOutOfBoundsException (nth (into-array [1 2 3]) 5)))
(is (thrown? IndexOutOfBoundsException (nth (into-array []) -1)))
(is (thrown? IndexOutOfBoundsException (nth (into-array [1 2 3]) -1)))
(is (thrown? StringIndexOutOfBoundsException (nth "" 0)))
(is (thrown? StringIndexOutOfBoundsException (nth "abc" 5)))
(is (thrown? StringIndexOutOfBoundsException (nth "" -1)))
(is (thrown? StringIndexOutOfBoundsException (nth "abc" -1)))
(is (thrown? IndexOutOfBoundsException (nth (java.util.ArrayList. []) 0)))
(is (thrown? IndexOutOfBoundsException (nth (java.util.ArrayList. [1 2 3]) 5)))
(is (thrown? IndexOutOfBoundsException (nth (java.util.ArrayList. []) -1))) ; ???
(is (thrown? IndexOutOfBoundsException (nth (java.util.ArrayList. [1 2 3]) -1))) ; ???
(nth (java.util.ArrayList. [1]) 0) 1
(nth (java.util.ArrayList. [1 2 3]) 0) 1
(nth (java.util.ArrayList. [1 2 3 4 5]) 1) 2
(nth (java.util.ArrayList. [1 2 3 4 5]) 4) 5
(nth (java.util.ArrayList. [1 2 3]) 5 :not-found) :not-found )
; regex Matchers
(let [m (re-matcher #"(a)(b)" "ababaa")]
(re-find m) ; => ["ab" "a" "b"]
(are [x y] (= x y)
(nth m 0) "ab"
(nth m 1) "a"
(nth m 2) "b"
(nth m 3 :not-found) :not-found
(nth m -1 :not-found) :not-found )
(is (thrown? IndexOutOfBoundsException (nth m 3)))
(is (thrown? IndexOutOfBoundsException (nth m -1))))
(let [m (re-matcher #"c" "ababaa")]
(re-find m) ; => nil
(are [x y] (= x y)
(nth m 0 :not-found) :not-found
(nth m 2 :not-found) :not-found
(nth m -1 :not-found) :not-found )
(is (thrown? IllegalStateException (nth m 0)))
(is (thrown? IllegalStateException (nth m 2)))
(is (thrown? IllegalStateException (nth m -1)))))
; 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)
(distinct []) ()
(distinct [1]) '(1)
(distinct [1 2 3]) '(1 2 3)
(distinct [1 2 3 1 2 2 1 1]) '(1 2 3)
(distinct [1 1 1 2]) '(1 2)
(distinct [1 2 1 2]) '(1 2)
(distinct "") ()
(distinct "a") '(\a)
(distinct "abc") '(\a \b \c)
(distinct "abcabab") '(\a \b \c)
(distinct "aaab") '(\a \b)
(distinct "abab") '(\a \b) )
(are [x] (= (distinct [x 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} ))
;; reduce
(is (= [1 2 4 8 16] (map #(reduce * (repeat % 2)) (range 5))))
(is (= [3 6 12 24 48] (map #(reduce * 3 (repeat % 2)) (range 5))))
;; equality and hashing
(is (= (repeat 5 :x) (repeat 5 :x)))
(is (= (repeat 5 :x) '(:x :x :x :x :x)))
(is (= (hash (repeat 5 :x)) (hash '(:x :x :x :x :x))))
(is (= (assoc (array-map (repeat 1 :x) :y) '(:x) :z) {'(:x) :z}))
(is (= (assoc (hash-map (repeat 1 :x) :y) '(:x) :z) {'(:x) :z})))
;; test other fns
(is (= '(:foo 42 :foo 42) (take 4 (iterate #(if (= % :foo) 42 :foo) :foo))))
(is (= '(1 false true true) (take 4 (iterate #(instance? Boolean %) 1))))
(is (= '(256 128 64 32 16 8 4 2 1 0) (take 10 (iterate #(quot % 2) 256))))
(is (= '(0 true) (take 2 (iterate zero? 0))))
(is (= 2 (first (next (next (iterate inc 0))))))
(is (= [1 2 3] (into [] (take 3) (next (iterate inc 0)))))
;; reduce via transduce
(is (= (transduce (take 5) + (iterate #(* 2 %) 2)) 62))
(is (= (transduce (take 5) + 1 (iterate #(* 2 %) 2)) 63)) )
(deftest test-split-at
(is (vector? (split-at 2 [])))
(is (vector? (split-at 2 [1 2 3])))
(are [x y] (= x y)
(split-at 2 []) [() ()]
(split-at 2 [1 2 3 4 5]) [(list 1 2) (list 3 4 5)]
(split-at 5 [1 2 3]) [(list 1 2 3) ()]
(split-at 0 [1 2 3]) [() (list 1 2 3)]
(split-at -1 [1 2 3]) [() (list 1 2 3)]
(split-at -5 [1 2 3]) [() (list 1 2 3)] ))
(deftest test-split-with
(is (vector? (split-with pos? [])))
(is (vector? (split-with pos? [1 2 -1 0 3 4])))
(are [x y] (= x y)
(split-with pos? []) [() ()]
(split-with pos? [1 2 -1 0 3 4]) [(list 1 2) (list -1 0 3 4)]
(split-with pos? [-1 2 3 4 5]) [() (list -1 2 3 4 5)]
(split-with number? [1 -2 "abc" \x]) [(list 1 -2) (list "abc" \x)] ))
(deftest test-repeat
;(is (thrown? IllegalArgumentException (repeat)))
; test different data types
(are [x] (= (repeat 3 x) (list x 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})
; CLJ-2718
(is (= '(:a) (drop 1 (repeat 2 :a))))
(is (= () (drop 2 (repeat 2 :a))))
(is (= () (drop 3 (repeat 2 :a)))))
(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) ")"))))))
(are [x y] (= x y)
true (every? #{:a} [:a :a])
;! false (every? #{:a} [:a :b]) ; Issue 68: every? returns nil instead of false
;! false (every? #{:a} [:b :b]) ; http://code.google.com/p/clojure/issues/detail?id=68
))
(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))
;; kf does not stop on false
(let [iter #(iteration (fn [k]
(if (boolean? k)
[10 :boolean]
[k k]))
:vf second
:kf (fn [[k v]]
(cond
(= k 3) false
(< k 14) (inc k)))
:initk 0)]
(is (= [0 1 2 3 :boolean 11 12 13 14]
(into [] (iter))
(seq (iter))))))
(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))))))
;; paginated API
(let [items 12 pgsize 5
src (vec (repeatedly items #(java.util.UUID/randomUUID)))
api (fn [tok]
(let [tok (or tok 0)]
(when (< tok items)
{:tok (+ tok pgsize)
:ret (subvec src tok (min (+ tok pgsize) items))})))]
(is (= src
(mapcat identity (iteration api :kf :tok :vf :ret))
(into [] cat (iteration api :kf :tok :vf :ret)))))
(let [src [:a :b :c :d :e]
api (fn [k]
(let [k (or k 0)]
(if (< k (count src))
{:item (nth src k)
:k (inc k)})))]
(is (= [:a :b :c]
(vec (iteration api
:somef (comp #{:a :b :c} :item)
:kf :k
:vf :item))
(vec (iteration api
:kf #(some-> % :k #{0 1 2})
:vf :item))))))
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]))
(defmacro should-print-to-err
[re & body]
`(is (re-find ~re (with-err-string-writer ~@body))))
(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"
; Read Integer
(is (instance? Long 2147483647))
(is (instance? Long +1))
(is (instance? Long 1))
(is (instance? Long +0))
(is (instance? Long 0))
(is (instance? Long -0))
(is (instance? Long -1))
(is (instance? Long -2147483648))
; Read Long
(is (instance? Long 2147483648))
(is (instance? Long -2147483649))
(is (instance? Long 9223372036854775807))
(is (instance? Long -9223372036854775808))
;; Numeric constants of different types don't wash out. Regression fixed in
;; r1157. Previously the compiler saw 0 and 0.0 as the same constant and
;; caused the sequence to be built of Doubles.
(let [x 0.0]
(let [sequence (loop [i 0 l '()]
(if (< i 5)
(recur (inc i) (conj l i))
l))]
(is (= [4 3 2 1 0] sequence))
(is (every? #(instance? Long %)
sequence))))
; Read BigInteger
(is (instance? BigInt 9223372036854775808))
(is (instance? BigInt -9223372036854775809))
(is (instance? BigInt 10000000000000000000000000000000000000000000000000))
(is (instance? BigInt -10000000000000000000000000000000000000000000000000))
; Read Double
(is (instance? Double +1.0e+1))
(is (instance? Double +1.e+1))
(is (instance? Double +1e+1))
(is (instance? Double +1.0e1))
(is (instance? Double +1.e1))
(is (instance? Double +1e1))
(is (instance? Double +1.0e-1))
(is (instance? Double +1.e-1))
(is (instance? Double +1e-1))
(is (instance? Double 1.0e+1))
(is (instance? Double 1.e+1))
(is (instance? Double 1e+1))
(is (instance? Double 1.0e1))
(is (instance? Double 1.e1))
(is (instance? Double 1e1))
(is (instance? Double 1.0e-1))
(is (instance? Double 1.e-1))
(is (instance? Double 1e-1))
(is (instance? Double -1.0e+1))
(is (instance? Double -1.e+1))
(is (instance? Double -1e+1))
(is (instance? Double -1.0e1))
(is (instance? Double -1.e1))
(is (instance? Double -1e1))
(is (instance? Double -1.0e-1))
(is (instance? Double -1.e-1))
(is (instance? Double -1e-1))
(is (instance? Double +1.0))
(is (instance? Double +1.))
(is (instance? Double 1.0))
(is (instance? Double 1.))
(is (instance? Double +0.0))
(is (instance? Double +0.))
(is (instance? Double 0.0))
(is (instance? Double 0.))
(is (instance? Double -0.0))
(is (instance? Double -0.))
(is (instance? Double -1.0))
(is (instance? Double -1.))
(is (= Double/POSITIVE_INFINITY ##Inf))
(is (= Double/NEGATIVE_INFINITY ##-Inf))
(is (and (instance? Double ##NaN) (.isNaN ##NaN)))
; Read BigDecimal
(is (instance? BigDecimal 9223372036854775808M))
(is (instance? BigDecimal -9223372036854775809M))
(is (instance? BigDecimal 2147483647M))
(is (instance? BigDecimal +1M))
(is (instance? BigDecimal 1M))
(is (instance? BigDecimal +0M))
(is (instance? BigDecimal 0M))
(is (instance? BigDecimal -0M))
(is (instance? BigDecimal -1M))
(is (instance? BigDecimal -2147483648M))
(is (instance? BigDecimal +1.0e+1M))
(is (instance? BigDecimal +1.e+1M))
(is (instance? BigDecimal +1e+1M))
(is (instance? BigDecimal +1.0e1M))
(is (instance? BigDecimal +1.e1M))
(is (instance? BigDecimal +1e1M))
(is (instance? BigDecimal +1.0e-1M))
(is (instance? BigDecimal +1.e-1M))
(is (instance? BigDecimal +1e-1M))
(is (instance? BigDecimal 1.0e+1M))
(is (instance? BigDecimal 1.e+1M))
(is (instance? BigDecimal 1e+1M))
(is (instance? BigDecimal 1.0e1M))
(is (instance? BigDecimal 1.e1M))
(is (instance? BigDecimal 1e1M))
(is (instance? BigDecimal 1.0e-1M))
(is (instance? BigDecimal 1.e-1M))
(is (instance? BigDecimal 1e-1M))
(is (instance? BigDecimal -1.0e+1M))
(is (instance? BigDecimal -1.e+1M))
(is (instance? BigDecimal -1e+1M))
(is (instance? BigDecimal -1.0e1M))
(is (instance? BigDecimal -1.e1M))
(is (instance? BigDecimal -1e1M))
(is (instance? BigDecimal -1.0e-1M))
(is (instance? BigDecimal -1.e-1M))
(is (instance? BigDecimal -1e-1M))
(is (instance? BigDecimal +1.0M))
(is (instance? BigDecimal +1.M))
(is (instance? BigDecimal 1.0M))
(is (instance? BigDecimal 1.M))
(is (instance? BigDecimal +0.0M))
(is (instance? BigDecimal +0.M))
(is (instance? BigDecimal 0.0M))
(is (instance? BigDecimal 0.M))
(is (instance? BigDecimal -0.0M))
(is (instance? BigDecimal -0.M))
(is (instance? BigDecimal -1.0M))
(is (instance? BigDecimal -1.M))
(is (instance? Ratio 1/2))
(is (instance? Ratio -1/2))
(is (instance? Ratio +1/2))
)
(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)
;; Dispatch (#)
(let [a 5]
^:added-metadata
(defn add-5
[x]
(reduce + x (range a))))"
stream (clojure.lang.LineNumberingPushbackReader.
(java.io.StringReader. code))
top-levels (take-while identity (repeatedly #(read stream false nil)))
expected-metadata '{ns {:line 1, :column 1}
:require {:line 2, :column 3}
resource {:line 3, :column 21}
let {:line 5, :column 1}
defn {:line 6, :column 3 :added-metadata true}
reduce {:line 9, :column 5}
range {:line 9, :column 17}}
verified-forms (atom 0)]
(doseq [form top-levels]
(clojure.walk/postwalk
#(when (list? %)
(is (= (expected-metadata (first %))
(meta %)))
(is (->> (meta %)
vals
(filter number?)
(every? (partial instance? Integer))))
(swap! verified-forms inc))
form))
;; sanity check against e.g. reading returning ()
(is (= (count expected-metadata) @verified-forms))))
(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})))
;; (read)
;; (read stream)
;; (read stream eof-is-error)
;; (read stream eof-is-error eof-value)
;; (read stream eof-is-error eof-value is-recursive)
(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-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)))
(let [[r s] (read+string {:read-cond :allow :features #{:y}} (str->lnpr "#?(:x :foo :y :bar)"))]
(is (= :bar r))
(is (= "#?(:x :foo :y :bar)" 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]))))
(eval (-> "^{:line 42 :column 99} (defn explicit-line-numbering [])" str->lnpr read))
(is (= {:line 42 :column 99}
(-> 'explicit-line-numbering resolve 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]))
;; temporary hack until I decide how to cleanly reload protocol
;; this no longer works
(defn reload-example-protocols
[]
(alter-var-root #'clojure.test-clojure.protocols.examples/ExampleProtocol
assoc :impls {})
(alter-var-root #'clojure.test-clojure.protocols.more-examples/SimpleProtocol
assoc :impls {})
(require :reload
'clojure.test-clojure.protocols.examples
'clojure.test-clojure.protocols.more-examples))
(defn method-names
"return sorted list of method names on a class"
[c]
(->> (.getMethods c)
(map #(.getName %))
(sort)))
(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))))))))
(deftype HasMarkers []
ExampleProtocol
(foo [this] "foo")
MarkerProtocol
MarkerProtocol2)
(deftype WillGetMarker []
ExampleProtocol
(foo [this] "foo"))
(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}))))
(defrecord RecordToTestStatics1 [a])
(defrecord RecordToTestStatics2 [a b])
(defrecord RecordToTestStatics3 [a b c])
(defrecord RecordToTestBasis [a b c])
(defrecord RecordToTestBasisHinted [^String a ^Long b c])
(defrecord RecordToTestHugeBasis [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])
(defrecord TypeToTestBasis [a b c])
(defrecord TypeToTestBasisHinted [^String a ^Long b c])
(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}}})))
(testing "that records and types are evalable"
(is (= (RecordToTestLiterals. 42) (eval #clojure.test_clojure.protocols.RecordToTestLiterals[42])))
(is (= (RecordToTestLiterals. 42) (eval #clojure.test_clojure.protocols.RecordToTestLiterals{:a 42})))
(is (= (RecordToTestLiterals. 42) (eval (RecordToTestLiterals. 42))))
(is (= (RecordToTestLiterals. (RecordToTestLiterals. 42))
(eval #clojure.test_clojure.protocols.RecordToTestLiterals[#clojure.test_clojure.protocols.RecordToTestLiterals[42]])))
(is (= (RecordToTestLiterals. (RecordToTestLiterals. 42))
(eval #clojure.test_clojure.protocols.RecordToTestLiterals[#clojure.test_clojure.protocols.RecordToTestLiterals{:a 42}])))
(is (= (RecordToTestLiterals. (RecordToTestLiterals. 42))
(eval #clojure.test_clojure.protocols.RecordToTestLiterals{:a #clojure.test_clojure.protocols.RecordToTestLiterals[42]})))
(is (= 42 (.a (eval #clojure.test_clojure.protocols.TypeToTestLiterals[42])))))
(testing "that ctor literals only work with constants or statics"
(is (thrown? Exception (read-string "#java.util.Locale[(str 'en)]")))
(is (thrown? Exception (read-string "(let [s \"en\"] #java.util.Locale[(str 'en)])")))
(is (thrown? Exception (read-string "#clojure.test_clojure.protocols.RecordToTestLiterals{(keyword \"a\") 42}"))))
(testing "that ctors can have whitespace after class name but before {"
(is (= (RecordToTestLiterals. 42)
(read-string "#clojure.test_clojure.protocols.RecordToTestLiterals {:a 42}"))))
(testing "that the correct errors are thrown with malformed literals"
(is (thrown-with-msg?
Exception
#"Unreadable constructor form.*"
(read-string "#java.util.Locale(\"en\")")))
(is (thrown-with-msg?
Exception
#"Unexpected number of constructor arguments.*"
(read-string "#java.util.Locale[\"\" \"\" \"\" \"\"]")))
(is (thrown? Exception (read-string "#java.util.Nachos(\"en\")")))))
(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))))
(defprotocol Dasherizer
(-do-dashed [this]))
(deftype Dashed []
Dasherizer
(-do-dashed [this] 10))
(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]))
;; 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")))
(are [s] ;; throw on invalid type (not string)
(try (parse-boolean s) (is false) (catch Throwable _ (is true)))
nil
false
true
100))
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]))
(defn all-pairs-equal [equal-var vals]
(doseq [val1 vals]
(doseq [val2 vals]
(is (equal-var val1 val2)
(str "Test that " val1 " (" (class val1) ") "
equal-var " " val2 " (" (class val2) ")")))))
(defn all-pairs-hash-consistent-with-= [vals]
(doseq [val1 vals]
(doseq [val2 vals]
(when (= val1 val2)
(is (= (hash val1) (hash val2))
(str "Test that (hash " val1 ") (" (class val1) ") "
" = (hash " val2 ") (" (class val2) ")"))))))
(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)])
;; No BigIntegers or floats in following tests, because hash
;; consistency with = for them is out of scope for Clojure
;; (CLJ-1036).
(all-pairs-hash-consistent-with-= [(byte 2) (short 2) (int 2) (long 2)
(bigint 2)
(double 2.0) 2.0M 2.00M])
(all-pairs-hash-consistent-with-= [(/ 3 2) (double 1.5) 1.50M 1.500M])
(all-pairs-hash-consistent-with-= [(double -0.0) (double 0.0) -0.0M -0.00M 0.0M 0.00M (float -0.0) (float 0.0)])
(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
(def expected-casts
[
[:input [-1 0 1 Byte/MAX_VALUE Short/MAX_VALUE Integer/MAX_VALUE Long/MAX_VALUE Float/MAX_VALUE Double/MAX_VALUE]]
[char [:error (char 0) (char 1) (char 127) (char 32767) :error :error :error :error]]
[unchecked-char [(char 65535) (char 0) (char 1) (char 127) (char 32767) (char 65535) (char 65535) (char 65535) (char 65535)]]
[byte [-1 0 1 Byte/MAX_VALUE :error :error :error :error :error]]
[unchecked-byte [-1 0 1 Byte/MAX_VALUE -1 -1 -1 -1 -1]]
[short [-1 0 1 Byte/MAX_VALUE Short/MAX_VALUE :error :error :error :error]]
[unchecked-short [-1 0 1 Byte/MAX_VALUE Short/MAX_VALUE -1 -1 -1 -1]]
[int [-1 0 1 Byte/MAX_VALUE Short/MAX_VALUE Integer/MAX_VALUE :error :error :error]]
[unchecked-int [-1 0 1 Byte/MAX_VALUE Short/MAX_VALUE Integer/MAX_VALUE -1 Integer/MAX_VALUE Integer/MAX_VALUE]]
[long [-1 0 1 Byte/MAX_VALUE Short/MAX_VALUE Integer/MAX_VALUE Long/MAX_VALUE :error :error]]
[unchecked-long [-1 0 1 Byte/MAX_VALUE Short/MAX_VALUE Integer/MAX_VALUE Long/MAX_VALUE Long/MAX_VALUE Long/MAX_VALUE]]
;; 2.14748365E9 if when float/double conversion is avoided...
[float [-1.0 0.0 1.0 127.0 32767.0 2.147483648E9 9.223372036854776E18 Float/MAX_VALUE :error]]
[unchecked-float [-1.0 0.0 1.0 127.0 32767.0 2.147483648E9 9.223372036854776E18 Float/MAX_VALUE Float/POSITIVE_INFINITY]]
[double [-1.0 0.0 1.0 127.0 32767.0 2.147483647E9 9.223372036854776E18 Float/MAX_VALUE Double/MAX_VALUE]]
[unchecked-double [-1.0 0.0 1.0 127.0 32767.0 2.147483647E9 9.223372036854776E18 Float/MAX_VALUE Double/MAX_VALUE]]])
(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)))))
(is (> (+ Integer/MAX_VALUE 10) Integer/MAX_VALUE)) ; no overflow
(is (thrown? ClassCastException (+ "ab" "cd"))) ) ; no string concatenation
(deftest test-subtract
(is (thrown? IllegalArgumentException (-)))
(are [x y] (= x y)
(- 1) -1
(- 1 2) -1
(- 1 2 3) -4
(is (< (- Integer/MIN_VALUE 10) Integer/MIN_VALUE)) ) ; no underflow
(is (> (* 3 (int (/ Integer/MAX_VALUE 2.0))) Integer/MAX_VALUE)) ) ; no overflow
(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)))))
(is (thrown? ArithmeticException (/ 0)))
(is (thrown? ArithmeticException (/ 2 0)))
(is (thrown? IllegalArgumentException (/))) )
;; mod
;; http://en.wikipedia.org/wiki/Modulo_operation
;; http://mathforum.org/library/drmath/view/52343.html
;;
;; is mod correct?
;; http://groups.google.com/group/clojure/browse_frm/thread/2a0ee4d248f3d131#
;;
;; Issue 23: mod (modulo) operator
;; http://code.google.com/p/clojure/issues/detail?id=23
(deftest test-mod
; wrong number of args
; (is (thrown? IllegalArgumentException (mod)))
; (is (thrown? IllegalArgumentException (mod 1)))
; (is (thrown? IllegalArgumentException (mod 3 2 1)))
; divide by zero
(is (thrown? ArithmeticException (mod 9 0)))
(is (thrown? ArithmeticException (mod 0 0)))
(deftest test-rem
; wrong number of args
; (is (thrown? IllegalArgumentException (rem)))
; (is (thrown? IllegalArgumentException (rem 1)))
; (is (thrown? IllegalArgumentException (rem 3 2 1)))
; divide by zero
(is (thrown? ArithmeticException (rem 9 0)))
(is (thrown? ArithmeticException (rem 0 0)))
(are [x y] (= x y)
(rem 4 2) 0
(rem 3 2) 1
(rem 6 4) 2
(rem 0 5) 0
(deftest test-quot
; wrong number of args
; (is (thrown? IllegalArgumentException (quot)))
; (is (thrown? IllegalArgumentException (quot 1)))
; (is (thrown? IllegalArgumentException (quot 3 2 1)))
; divide by zero
(is (thrown? ArithmeticException (quot 9 0)))
(is (thrown? ArithmeticException (quot 0 0)))
(are [x y] (= x y)
(quot 4 2) 2
(quot 3 2) 1
(quot 6 4) 1
(quot 0 5) 0
(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)))))
(defn- expt
"clojure.contrib.math/expt is a better and much faster impl, but this works.
Math/pow overflows to Infinity."
[x n] (apply *' (replicate n x)))
(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))))
(deftest test-ratios
(is (== (denominator 1/2) 2))
(is (== (numerator 1/2) 1))
(is (= (bigint (/ 100000000000000000000 3)) 33333333333333333333))
(is (= (long 10000000000000000000/3) 3333333333333333333))
;; special cases around Long/MIN_VALUE
(is (= (/ 1 Long/MIN_VALUE) -1/9223372036854775808))
(is (true? (< (/ 1 Long/MIN_VALUE) 0)))
(is (true? (< (* 1 (/ 1 Long/MIN_VALUE)) 0)))
(is (= (abs (/ 1 Long/MIN_VALUE)) 1/9223372036854775808))
(is (false? (< (abs (/ 1 Long/MIN_VALUE)) 0)))
(is (false? (< (* 1 (abs (/ 1 Long/MIN_VALUE))) 0)))
(is (= (/ Long/MIN_VALUE -3) 9223372036854775808/3))
(is (false? (< (/ Long/MIN_VALUE -3) 0))))
(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))))
(defn integer
"Distribution of integers biased towards the small, but
including all longs."
[]
(gen/one-of #(gen/uniform -1 32) gen/byte gen/short gen/int gen/long))
(defspec integer-distributive-laws
(partial map identity)
[^{:tag `integer} a ^{:tag `integer} b ^{:tag `integer} c]
(if (every? longable? [(*' a (+' b c)) (+' (*' a b) (*' a c))
(*' a b) (*' a c) (+' b c)])
(assert (= (* a (+ b c)) (+ (* a b) (* a c))
(*' a (+' b c)) (+' (*' a b) (*' a c))
(unchecked-multiply a (+' b c)) (+' (unchecked-multiply a b) (unchecked-multiply a c))))
(assert (= (*' a (+' b c)) (+' (*' a b) (*' a c))
(* a (+ (bigint b) c)) (+ (* (bigint a) b) (* (bigint a) c))))))
(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))))))
(defmacro check-warn-on-box [warn? form]
`(do (binding [*unchecked-math* :warn-on-boxed]
(is (= ~warn?
(boolean
(re-find #"^Boxed math warning"
(helper/with-err-string-writer
(helper/eval-in-temp-ns ~form)))))))
(binding [*unchecked-math* true]
(is (false?
(boolean
(re-find #"^Boxed math warning"
(helper/with-err-string-writer
(helper/eval-in-temp-ns ~form)))))))
(binding [*unchecked-math* false]
(is (false?
(boolean
(re-find #"^Boxed math warning"
(helper/with-err-string-writer
(helper/eval-in-temp-ns ~form)))))))))
(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
(deftest require-as-alias-then-load-later
;; alias but don't load
(require '[clojure.test-clojure.ns-libs-load-later :as-alias alias-now])
(is (contains? (ns-aliases *ns*) 'alias-now))
(is (not (nil? (find-ns 'clojure.test-clojure.ns-libs-load-later))))
;; not loaded!
(is (nil? (resolve 'alias-now/example)))
;; now loaded!
(is (not (nil? (resolve 'alias-now/example)))))
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-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")))))
; it is a Long, nothing else
(are [x y] (= (instance? x 42) y)
java.lang.Integer false
java.lang.Long true
java.lang.Character false
java.lang.String false )
; test compiler macro
(is (let [Long String] (instance? Long "abc")))
(is (thrown? clojure.lang.ArityException (instance? Long))))
(deftest test-set!
(is (= 1 (f (t. 1)))))
(:missing b) nil
(:missing b :default) :default
(get b :missing) nil
(get b :missing :default) :default
(deftest test-iterable-bean
(let [b (bean (java.util.Date.))]
(is (.iterator ^Iterable b))
(is (= (into [] b) (into [] (seq b))))
(is (hash b))))
;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))))))
;; serialized-proxy can be regenerated using a modified version of
;; Clojure with the proxy serialization prohibition disabled and the
;; following code:
;; revert 271674c9b484d798484d134a5ac40a6df15d3ac3 to allow serialization
(comment
(require 'clojure.inspector)
(let [baos (java.io.ByteArrayOutputStream.)]
(with-open [baos baos]
(.writeObject (java.io.ObjectOutputStream. baos) (clojure.inspector/list-model nil)))
(prn (vector (System/getProperty "java.specification.version")
(.encodeToString (java.util.Base64/getEncoder) (.toByteArray baos))))))
(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-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 test-make-array
; negative size
(is (thrown? NegativeArraySizeException (make-array Integer -1)))
(defn queue [& contents]
(apply conj (clojure.lang.PersistentQueue/EMPTY) contents))
(test-to-passed-array-for vector)
(test-to-passed-array-for list)
;;(test-to-passed-array-for hash-set)
(test-to-passed-array-for queue)
(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)) ))
(is (= \a (aget (into-array Character/TYPE [\a \b \c]) 0)))
(is (= [nil 1 2] (seq (into-array [nil 1 2]))))
(let [types [Integer/TYPE
Byte/TYPE
Float/TYPE
Short/TYPE
Double/TYPE
Long/TYPE]
values [(byte 2) (short 3) (int 4) 5]]
(for [t types]
(let [a (into-array t values)]
(is (== (aget a 0) 2))
(is (== (aget a 1) 3))
(is (== (aget a 2) 4))
(is (== (aget a 3) 5)))))
; different kinds of collections
(are [x] (and (= (alength (into-array x)) (count x))
(= (vec (into-array x)) (vec x))
(= (alength (into-array Long/TYPE x)) (count x))
(= (vec (into-array Long/TYPE x)) (vec x)))
()
'(1 2)
[]
[1 2]
(sorted-set)
(sorted-set 1 2)
(deftest test-to-array-2d
; needs to be a collection of collection(s)
(is (thrown? Exception (to-array-2d [1 2 3])))
(deftest test-char
; int -> char
(is (instance? java.lang.Character (char 65)))
; char -> char
(is (instance? java.lang.Character (char \a)))
(is (= (char \a) \a)))
; Test that primitive boxing elision in statement context works
; correctly (CLJ-2621)
(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"))))
;; print to stderr, capture nil
(is (nil? (p/exec "bash" "-c" "ls >&2")))
;; redirect, then capture to string
(is (not (str/blank? (p/exec {:err :stdout} "bash" "-c" "ls >&2")))))
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 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-interop
(:require [clojure.test :refer :all]
[clojure.test.check.generators :as gen]
[clojure.test.check.properties :as prop]
[clojure.test.check.clojure-test :refer (defspec)]))
(defn gen-gvec
([]
(gen/bind (gen/elements {:int gen/int
:short (gen/fmap short gen/byte)
:long (gen/fmap long gen/int)
:float (gen/fmap float gen/int)
:double (gen/fmap double gen/int)
:byte gen/byte
:char gen/char
:boolean gen/boolean})
#(apply gen-gvec %)))
([type generator]
(gen/bind (gen/list generator) #(gen/return (apply vector-of type %)))))
(defn gen-hash-set [generator]
(gen/fmap (partial apply hash-set) (gen/list generator)))
(defn gen-sorted-set [generator]
(gen/fmap (partial apply sorted-set) (gen/list generator)))
(defn gen-array
([]
(gen/bind (gen/elements {int-array gen/int
short-array gen/int
long-array (gen/fmap long gen/int)
float-array (gen/fmap float gen/int)
double-array (gen/fmap double gen/int)
byte-array gen/byte
char-array gen/char
boolean-array gen/boolean
object-array gen/string})
#(apply gen-array %)))
([array-fn generator]
(gen/fmap array-fn (gen/list generator))))
(defn exaust-iterator-backward [^java.util.ListIterator iter]
(loop [_ iter] (when (.hasPrevious iter) (recur (.previous iter))))
(try (.previous iter) nil (catch Throwable t t)))
(defspec iterator-throws-exception-on-exaustion 100
(prop/for-all [[_ x] (gen/bind (gen/elements [['list (gen/list gen/int)]
['vector (gen/vector gen/int)]
['vector-of (gen-gvec)]
['subvec (gen-subvec (gen/vector gen/int))]
['hash-set (gen-hash-set gen/int)]
['sorted-set (gen-sorted-set gen/int)]
['hash-map (gen/hash-map gen/symbol gen/int)]
['array-map (gen-array-map gen/symbol gen/int)]
['sorted-map (gen-sorted-map gen/symbol gen/int)]])
(fn [[s g]] (gen/tuple (gen/return s) g)))]
(instance? java.util.NoSuchElementException (exaust-iterator-forward (.iterator x)))))
(defspec list-iterator-throws-exception-on-forward-exaustion 50
(prop/for-all [[_ x] (gen/bind (gen/elements [['vector (gen/vector gen/int)]
['subvec (gen-subvec (gen/vector gen/int))]
['vector-of (gen-gvec)]])
(fn [[s g]] (gen/tuple (gen/return s) g)))]
(instance? java.util.NoSuchElementException (exaust-iterator-forward (.listIterator x)))))
(defspec list-iterator-throws-exception-on-backward-exaustion 50
(prop/for-all [[_ x] (gen/bind (gen/elements [['vector (gen/vector gen/int)]
['subvec (gen-subvec (gen/vector gen/int))]
['vector-of (gen-gvec)]])
(fn [[s g]] (gen/tuple (gen/return s) g)))]
(instance? java.util.NoSuchElementException (exaust-iterator-backward (.listIterator x)))))
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]))
(defn diff [s1 s2]
(seq (reduce disj (set s1) (set s2))))
;; *** Generative ***
(defspec subcollection-counts-are-consistent
identity
[^{:tag cgen/ednable-collection} coll]
(let [n (count coll)]
(dotimes [i n]
(is (= n
(+ i (count (nthnext coll i)))
(+ i (count (drop i coll))))))))
(defn gen-transient-set-action []
(gen/rand-nth [[#(conj! %1 %2) #(conj %1 %2) (gen/uniform -100 100)]
[#(disj! %1 %2) #(disj %1 %2) (gen/uniform -100 100)]
[#(deref (future (conj! %1 %2))) #(conj %1 %2) (gen/uniform -100 100)]
[#(deref (future (disj! %1 %2))) #(disj %1 %2) (gen/uniform -100 100)]
[persistent! identity]
[identity transient]]))
(defn gen-transient-vector-action []
(gen/rand-nth [[#(conj! %1 %2) #(conj %1 %2) (gen/uniform -100 100)]
[(fn [v _] (if (tempty? v) v (pop! v)))
(fn [v _] (if (tempty? v) v (pop v)))
(gen/uniform -100 100)]
[#(deref (future (conj! %1 %2))) #(conj %1 %2) (gen/uniform -100 100)]
[(fn [v _] (if (tempty? v) v (deref (future (pop! v)))))
(fn [v _] (if (tempty? v) v (pop v)))
(gen/uniform -100 100)]
[persistent! identity]
[identity transient]]))
(defn gen-transient-map-action []
(gen/rand-nth [[#(assoc! %1 %2 %2) #(assoc %1 %2 %2) (gen/uniform -100 100)]
[#(dissoc! %1 %2) #(dissoc %1 %2) (gen/uniform -100 100)]
[#(deref (future (assoc! %1 %2 %2))) #(assoc %1 %2 %2) (gen/uniform -100 100)]
[#(deref (future (dissoc! %1 %2))) #(dissoc %1 %2) (gen/uniform -100 100)]
[persistent! identity]
[identity transient]]))
(defn to-persistent [c]
(if (transient? c) (persistent! c) c))
(defspec same-output-persistent-transient-set
identity
[^{:tag clojure.test-clojure.data-structures/gen-transient-set-actions} actions]
(assert-same-collection
(to-persistent (apply-actions #{} actions))
(to-persistent (apply-actions #{} actions))))
(defspec same-output-persistent-transient-vector
identity
[^{:tag clojure.test-clojure.data-structures/gen-transient-vector-actions} actions]
(assert-same-collection
(to-persistent (apply-actions [] actions))
(to-persistent (apply-actions [] actions))))
(defspec same-output-persistent-transient-map
identity
[^{:tag clojure.test-clojure.data-structures/gen-transient-map-actions} actions]
(assert-same-collection
(to-persistent (apply-actions clojure.lang.PersistentArrayMap/EMPTY actions))
(to-persistent (apply-actions clojure.lang.PersistentArrayMap/EMPTY actions)))
(assert-same-collection
(to-persistent (apply-actions clojure.lang.PersistentHashMap/EMPTY actions))
(to-persistent (apply-actions clojure.lang.PersistentHashMap/EMPTY actions))))
(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) )
; ratios
(is (== 1/2 0.5))
(is (== 1/1000 0.001))
(is (not= 2/3 0.6666666666666666))
[] '() ; same again, but vectors first
[1] '(1)
[1 2] '(1 2) )
(is (not= [1 2] '(2 1))) ; order of items matters
; list and vector vs. set and map
(are [x y] (not= x y)
; only () equals []
() #{}
() {}
[] #{}
[] {}
#{} {}
; only '(1) equals [1]
'(1) #{1}
[1] #{1} )
; sorted-map, hash-map and array-map - classes differ, but content is equal
;; TODO: reimplement all-are with new do-template?
;; (all-are (not= (class _1) (class _2))
;; (sorted-map :a 1)
;; (hash-map :a 1)
;; (array-map :a 1))
;; (all-are (= _1 _2)
;; (sorted-map)
;; (hash-map)
;; (array-map))
;; (all-are (= _1 _2)
;; (sorted-map :a 1)
;; (hash-map :a 1)
;; (array-map :a 1))
;; (all-are (= _1 _2)
;; (sorted-map :a 1 :z 3 :c 2)
;; (hash-map :a 1 :z 3 :c 2)
;; (array-map :a 1 :z 3 :c 2))
(is (not= (sorted-set :a) (sorted-set 1)))
; sorted-set vs. hash-set
(is (not= (class (sorted-set 1)) (class (hash-set 1))))
(are [x y] (= x y)
(sorted-set-by <) (hash-set)
(sorted-set-by < 1) (hash-set 1)
(sorted-set-by < 3 2 1) (hash-set 3 2 1)
(sorted-set) (hash-set)
(sorted-set 1) (hash-set 1)
(sorted-set 3 2 1) (hash-set 3 2 1) ))
(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
(java.util.ArrayList. []) 0
(java.util.ArrayList. [1]) 1
(java.util.ArrayList. [1 2 3]) 3
(deftest test-conj
; doesn't work on strings or arrays
(is (thrown? ClassCastException (conj "" \a)))
(is (thrown? ClassCastException (conj (into-array []) 1)))
; list -> conj puts the item at the front of the list
(conj () 1) '(1)
(conj () 1 2) '(2 1)
; map -> conj expects another (possibly single entry) map as the item,
; and returns a new map which is the old map plus the entries
; from the new, which may overwrite entries of the old.
; conj also accepts a MapEntry or a vector of two items (key and value).
(conj {} {}) {}
(conj {} {:a 1}) {:a 1}
(conj {} {:a 1 :b 2}) {:a 1 :b 2}
(conj {} {:a 1 :b 2} {:c 3}) {:a 1 :b 2 :c 3}
(conj {} {:a 1 :b 2} {:a 3 :c 4}) {:a 3 :b 2 :c 4}
;; *** Lists and Vectors ***
(deftest test-peek
; doesn't work for sets and maps
(is (thrown? ClassCastException (peek #{1})))
(is (thrown? ClassCastException (peek {:a 1})))
; list = first
(peek ()) nil
(peek '(1)) 1
(peek '(1 2 3)) 1
(deftest test-pop
; doesn't work for sets and maps
(is (thrown? ClassCastException (pop #{1})))
(is (thrown? ClassCastException (pop #{:a 1})))
; collection cannot be empty
(is (thrown? IllegalStateException (pop ())))
(is (thrown? IllegalStateException (pop [])))
; list - pop first
(pop '(1)) ()
(pop '(1 2 3)) '(2 3)
;; *** Lists (IPersistentList) ***
(deftest test-list
(are [x] (list? x)
()
'()
(list)
(list 1 2 3) )
; order is important
(are [x y] (not (= x y))
(list 1 2) (list 2 1)
(list 3 1 2) (list 1 2 3) )
(are [x y] (= x y)
'() ()
(list) '()
(list 1) '(1)
(list 1 2) '(1 2)
; nesting
(list 1 (list 2 3) (list 3 (list 4 5 (list 6 (list 7)))))
'(1 (2 3) (3 (4 5 (6 (7)))))
; different data structures
(list true false nil)
'(true false nil)
(list 1 2.5 2/3 "ab" \x 'cd :kw)
'(1 2.5 2/3 "ab" \x cd :kw)
(list (list 1 2) [3 4] {:a 1 :b 2} #{:c :d})
'((1 2) [3 4] {:a 1 :b 2} #{:c :d})
; evaluation
(list (+ 1 2) [(+ 2 3) 'a] (list (* 2 3) 8))
'(3 [5 a] (6 8))
; special cases
(list nil) '(nil)
(list 1 nil) '(1 nil)
(list nil 2) '(nil 2)
(list ()) '(())
(list 1 ()) '(1 ())
(list () 2) '(() 2) ))
;; *** Maps (IPersistentMap) ***
(deftest test-contains?
; contains? is designed to work preferably on maps and sets
(are [x y] (= x y)
(contains? {} :a) false
(contains? {} nil) false
; numerically indexed collections (e.g. vectors and Java arrays)
; => test if the numeric key is WITHIN THE RANGE OF INDEXES
(are [x y] (= x y)
(contains? [] 0) false
(contains? [] -1) false
(contains? [] 1) false
; 'contains?' will not operate on non-associative things
(are [x] (is (thrown? Exception (contains? x 1)))
'(1 2 3)
3))
(are [x y] (= x y)
; (class {:a 1}) => clojure.lang.PersistentArrayMap
(keys {}) nil
(keys {:a 1}) '(:a)
(keys {nil 1}) '(nil)
(diff (keys {:a 1 :b 2}) '(:a :b)) nil ; (keys {:a 1 :b 2}) '(:a :b)
; (class (sorted-map :a 1)) => clojure.lang.PersistentTreeMap
(keys (sorted-map)) nil
(keys (sorted-map :a 1)) '(:a)
(diff (keys (sorted-map :a 1 :b 2)) '(:a :b)) nil ; (keys (sorted-map :a 1 :b 2)) '(:a :b)
; (class (hash-map :a 1)) => clojure.lang.PersistentHashMap
(keys (hash-map)) nil
(keys (hash-map :a 1)) '(:a)
(diff (keys (hash-map :a 1 :b 2)) '(:a :b)) nil ) ; (keys (hash-map :a 1 :b 2)) '(:a :b)
(let [m {:a 1 :b 2}
k (keys m)]
(is (= {:hi :there} (meta (with-meta k {:hi :there}))))))
(are [x y] (= x y)
; (class {:a 1}) => clojure.lang.PersistentArrayMap
(vals {}) nil
(vals {:a 1}) '(1)
(vals {nil 1}) '(1)
(diff (vals {:a 1 :b 2}) '(1 2)) nil ; (vals {:a 1 :b 2}) '(1 2)
; (class (sorted-map :a 1)) => clojure.lang.PersistentTreeMap
(vals (sorted-map)) nil
(vals (sorted-map :a 1)) '(1)
(diff (vals (sorted-map :a 1 :b 2)) '(1 2)) nil ; (vals (sorted-map :a 1 :b 2)) '(1 2)
; (class (hash-map :a 1)) => clojure.lang.PersistentHashMap
(vals (hash-map)) nil
(vals (hash-map :a 1)) '(1)
(diff (vals (hash-map :a 1 :b 2)) '(1 2)) nil ) ; (vals (hash-map :a 1 :b 2)) '(1 2)
(let [m {:a 1 :b 2}
v (vals m)]
(is (= {:hi :there} (meta (with-meta v {:hi :there}))))))
(deftest test-sorted-map-keys
(is (thrown? ClassCastException (sorted-map () 1)))
(is (thrown? ClassCastException (sorted-map #{} 1)))
(is (thrown? ClassCastException (sorted-map {} 1)))
(is (thrown? ClassCastException (assoc (sorted-map) () 1)))
(is (thrown? ClassCastException (assoc (sorted-map) #{} 1)))
(is (thrown? ClassCastException (assoc (sorted-map) {} 1)))
(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
; order isn't important
(are [x y] (= x y)
#{1 2} #{2 1}
#{3 1 2} #{1 2 3}
(hash-set 1 2) (hash-set 2 1)
(hash-set 3 1 2) (hash-set 1 2 3) )
; different data structures
(hash-set true false nil)
#{true false nil}
(hash-set 1 2.5 2/3 "ab" \x 'cd :kw)
#{1 2.5 2/3 "ab" \x 'cd :kw}
(hash-set (list 1 2) [3 4] {:a 1 :b 2} #{:c :d})
#{'(1 2) [3 4] {:a 1 :b 2} #{:c :d}}
(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])))
; equal and unique
(are [x] (and (= (sorted-set x) #{x})
(= (sorted-set x x) (sorted-set x)))
nil
false true
0 42
0.0 3.14
2/3
0M 1M
\c
"" "abc"
'sym
:kw
[] [1 2]
)
; cannot be cast to java.lang.Comparable
(is (thrown? ClassCastException (sorted-set ())))
(is (thrown? ClassCastException (sorted-set {})))
(is (thrown? ClassCastException (sorted-set #{})))
(is (thrown? ClassCastException (sorted-set '(1 2) '(1 2))))
(is (thrown? ClassCastException (sorted-set {:a 1 :b 2} {:a 1 :b 2})))
(is (thrown? ClassCastException (sorted-set #{1 2} #{1 2})))
(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])))
; equal and unique
(are [x] (and (= (sorted-set-by compare x) #{x})
(= (sorted-set-by compare x x) (sorted-set-by compare 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}
)
; cannot be cast to java.lang.Comparable
; 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 compare '(1 2) '(1 2))))
(is (thrown? Exception (sorted-set-by compare {:a 1 :b 2} {:a 1 :b 2})))
(is (thrown? Exception (sorted-set-by compare #{1 2} #{1 2})))
(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)))
; identity
(are [x] (= (disj x) x)
nil
#{}
#{1 2 3}
; different data types
#{nil
false true
0 42
0.0 3.14
2/3
0M 1M
\c
"" "abc"
'sym
:kw
[] [1 2]
{} {:a 1 :b 2}
#{} #{1 2}} )
; type identity
(are [x] (= (class (disj x)) (class x))
(hash-set)
(hash-set 1 2)
(sorted-set)
(sorted-set 1 2) )
(are [x y] (= x y)
(disj nil :a) nil
(disj nil :a :b) nil
(disj #{} :a) #{}
(disj #{} :a :b) #{}
(disj #{:a} :a) #{}
(disj #{:a} :a :b) #{}
(disj #{:a} :c) #{:a}
(disj #{:a :b :c :d} :a) #{:b :c :d}
(disj #{:a :b :c :d} :a :d) #{:b :c}
(disj #{:a :b :c :d} :a :b :c) #{:d}
(disj #{:a :b :c :d} :d :a :c :b) #{}
(disj #{nil} :a) #{nil}
(disj #{nil} #{}) #{nil}
(disj #{nil} nil) #{}
(disj #{#{}} nil) #{#{}}
(disj #{#{}} #{}) #{}
(disj #{#{nil}} #{nil}) #{} ))
(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))))
;; Sets
(is (thrown? IllegalArgumentException
(read-string "#{1 2 3 4 1 5}")))
;; If there are duplicate items when doing (conj #{} x1 x2 ...),
;; the behavior is that the metadata of the first item is kept.
(are [s x] (all-equal-sets-incl-meta s
(apply conj #{} x)
(set x)
(apply hash-set x)
(apply sorted-set x)
(apply sorted-set-by cmp-first x))
#{x1 y2} [x1 y2]
#{x1 z3a} [x1 z3a z3b]
#{w5b} [w5b w5a w5c]
#{z3a x1} [z3a z3b x1])
;; Maps
(is (thrown? IllegalArgumentException
(read-string "{:a 1, :b 2, :a -1, :c 3}")))
;; If there are duplicate keys when doing (assoc {} k1 v1 k2 v2
;; ...), the behavior is that the metadata of the first duplicate
;; key is kept, but mapped to the last value with an equal key
;; (where metadata of keys are not compared).
(are [h x] (all-equal-maps-incl-meta h
(apply assoc {} x)
(apply hash-map x)
(apply sorted-map x)
(apply sorted-map-by cmp-first x)
(apply array-map x))
{x1 2, z3a 4} [x1 2, z3a 4]
{x1 2, z3a 5} [x1 2, z3a 4, z3b 5]
{z3a 5} [z3a 2, z3a 4, z3b 5]
{z3b 4, x1 5} [z3b 2, z3a 4, x1 5]
{z3b v4b, x1 5} [z3b v4a, z3a v4b, x1 5]
{x1 v4a, w5a v4c, v4a z3b, y2 2} [x1 v4a, w5a v4a, w5b v4b,
v4a z3a, y2 2, v4b z3b, w5c v4c])))
(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))))
(defn is-same-collection [a b]
(let [msg (format "(class a)=%s (class b)=%s a=%s b=%s"
(.getName (class a)) (.getName (class b)) a b)]
(is (= (count a) (count b)) msg)
(when (instance? Collection a)
(is (= (count a) (.size a)) msg))
(when (instance? Collection b)
(is (= (count b) (.size b)) msg))
(is (= a b) msg)
(is (= b a) msg)
(is (.equals ^Object a b) msg)
(is (.equals ^Object b a) msg)
(is (= (hash a) (hash b)) msg)
(is (= (.hashCode ^Object a) (.hashCode ^Object b)) msg)))
(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))))
(defspec ordered-collection-hashes-match
identity
[^{:tag clojure.test-clojure.data-structures/gen-elements} elem]
(let [v (vec elem)
l (apply list elem)]
(is (= (hash v)
(hash l)
(hash (map identity elem))
(hash-ordered elem)))))
(defspec unordered-set-hashes-match
identity
[^{:tag clojure.test-clojure.data-structures/gen-elements} elem]
(let [unique-elem (distinct elem)
s (into #{} unique-elem)]
(is (= (hash s)
(hash-unordered unique-elem)))))
(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)))))
(defn gen-queue
[]
(into clojure.lang.PersistentQueue/EMPTY
(gen/vec (rand-nth cgen/ednable-scalars))))
(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))))))
(defn hinted
(^String [])
(^Integer [a])
(^java.util.List [a & args]))
(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 []))))))
(should-print-err-message #"(?s).*k is not matching primitive.*"
#(loop [k (clojure.test-clojure.compilation/primfn)] (recur :foo))))
#_(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}))))
;; compile uses a separate code path so we have to call it directly
;; to test it
(letfn [(compile [s]
(spit "test/clojure/bad_def_test.clj" (str "(ns clojure.bad-def-test)\n" s))
(try
(binding [*compile-path* "test"]
(clojure.core/compile 'clojure.bad-def-test))
(finally
(doseq [f (.listFiles (java.io.File. "test/clojure"))
:when (re-find #"bad_def_test" (str f))]
(.delete f)))))]
(testing "do in a vector throws an exception in compilation"
(is (thrown? Compiler$CompilerException (compile "[do 1 2 3]"))))
(testing "do in a set throws an exception in compilation"
(is (thrown? Compiler$CompilerException (compile "#{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)))))
(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
a (atom nil)
closed-over-in-finally (fn []
(try
:ret
(finally
(reset! a :run))))]
(is (= :foo (closed-over-in-catch)))
(is (= :ret (closed-over-in-finally)))
(is (= :run @a))))
(testing "no clearing when loop not in return context"
(let [x (atom 5)
bad (fn []
(loop [] (System/getProperties))
(swap! x dec)
(when (pos? @x)
(recur)))]
(is (nil? (bad))))))
(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)))))
riemann/riemann
(ns riemann.sns-test
(:require [riemann.common :refer [time-at count-string-bytes]]
[riemann.sns :refer :all]
[riemann.time :refer [unix-time]]
[clojure.test :refer :all])
(:import [com.amazonaws.services.sns.model PublishResult]))
(deftest override-formatting-test
(let [message (#'riemann.sns/compose-message
{:body (fn [events]
(apply str "body "
(map :service events)))
:subject (fn [events]
(apply str "subject "
(map :service events)))
:arn ["my:arn"]}
{:service "foo"})]
(is (= message {:arns (list "my:arn") :body "body foo" :subject "subject foo"}))))
(deftest is-message-truncated-test
(let [a (promise)]
; delivers: arn body subject
(with-redefs [riemann.sns/aws-sns-publish #(deliver a [%2 %3 %4])]
(sns-publish fake-aws-opts
{:arn ["my:arn"]}
{:service (apply str (repeat 8093 "あ")) :time 0}))
(is (<= (count-string-bytes (nth @a 1)) 8092))
(is (<= (count-string-bytes (nth @a 2)) 100))))
(deftest sns-publisher-static-subject-overriding-test
(let [a (promise)
sns (sns-publisher fake-aws-opts {:subject "something went wrong"})
stream (sns "test:arn")]
(with-redefs [riemann.sns/aws-sns-publish #(deliver a [%2 %3 %4])]
(stream fake-event))
(is (= @a ["test:arn" fake-event-body "something went wrong"]))))
(deftest sns-publisher-sync-test
(let [a (promise)
sns (sns-publisher fake-aws-opts)
stream (sns "test:arn")]
(with-redefs [riemann.sns/aws-sns-publish #(deliver a [%2 %3 %4])]
(stream fake-event))
(is (= @a ["test:arn" fake-event-body fake-event-subject]))))
(deftest sns-publisher-default-chain-test
(let [a (promise)
sns (sns-publisher)
stream (sns "test:arn")]
(with-redefs [riemann.sns/aws-sns-publish #(deliver a [%2 %3 %4])]
(stream fake-event))
(is (= @a ["test:arn" fake-event-body fake-event-subject]))))
(deftest sns-publisher-async-test
(let [a (promise)
done (promise)
fail (promise)
sns (sns-publisher (merge fake-aws-opts {:async true}))
stream (sns "test:arn:async")]
(with-redefs [riemann.sns/aws-sns-publish-async #(deliver a [%2 %3 %4])]
(stream fake-event))
(is (= @a ["test:arn:async" fake-event-body fake-event-subject]))))
(deftest sns-publisher-async-callbacks-test
(let [a (promise)
done (promise)
fail (promise)
success #(deliver done [%1 %2])
error #(deliver fail [%1])
sns (sns-publisher fake-aws-opts {} {:async true :success success :error error})
stream (sns "test:arn:async:callbacks")]
(with-redefs [riemann.sns/aws-sns-publish-async #(deliver a [%2 %3 %4 %5 %6])]
(stream fake-event))
(is (= @a ["test:arn:async:callbacks" fake-event-body fake-event-subject success error]))))
(deftest sns-publisher-insufficient-async-callbacks-test
(is (thrown? AssertionError (sns-publisher fake-aws-opts {} {:async true :success #(prn %1 %2)}))))
(let [aws-opts {:access-key env-access-key-id
:secret-key env-secret-access-key
:region env-region}
done (promise)
fail (promise)
sns-sync (sns-publisher aws-opts)
sns-default-chain (sns-publisher {})
sns-async (sns-publisher aws-opts {} {:async true})
sns-callbacks (sns-publisher aws-opts {} {:async true
:success #(deliver done [%2])
:error #(deliver fail [%1])})
event (merge fake-event {:time (unix-time)})]
((sns-sync env-arn) (merge event {:service "sns sync test"}))
((sns-default-chain env-arn) (merge event {:service "sns default credential chain test"}))
((sns-async env-arn) (merge event {:service "sns async test"}))
((sns-callbacks env-arn) (merge event {:service "sns async callback test"}))
((sns-callbacks (str env-arn ":non:existent")) (merge event {:service "sns async callback test"}))
(is (instance? PublishResult (first (deref done 10000 nil))))
(is (instance? Exception (first (deref fail 10000 nil))))))
weavejester/compojure
(ns compojure.route-test
(:require [clojure.test :refer :all]
[ring.mock.request :as mock]
[compojure.route :as route]))
(deftest not-found-route
(testing "string body"
(let [response ((route/not-found "foo") (mock/request :get "/"))]
(is (= (:status response) 404))
(is (= (:body response) "foo"))))
(testing "response map body"
(let [response ((route/not-found {:status 200 :body "bar"})
(mock/request :get "/"))]
(is (= (:status response) 404))
(is (= (:body response) "bar"))))
(testing "async arity"
(let [handler (route/not-found "baz")
response (promise)
exception (promise)]
(handler (mock/request :get "/") response exception)
(is (not (realized? exception)))
(is (= (:status @response) 404))
(is (= (:body @response) "baz")))))
(deftest resources-route
(let [route (route/resources "/foo" {:root "test_files"})
response (route (mock/request :get "/foo/test.txt"))]
(is (= (:status response) 200))
(is (= (slurp (:body response)) "foobar\n"))
(is (= (get-in response [:headers "Content-Type"])
"text/plain"))))
(deftest files-route
(testing "text file"
(let [route (route/files "/foo" {:root "test/test_files"})
response (route (mock/request :get "/foo/test.txt"))]
(is (= (:status response) 200))
(is (= (slurp (:body response)) "foobar\n"))
(is (= (get-in response [:headers "Content-Type"])
"text/plain"))))
(testing "root"
(let [route (route/files "/" {:root "test/test_files"})
response (route (mock/request :get "/"))]
(is (= (:status response) 200))
(is (= (slurp (:body response)) "<!doctype html><title></title>\n"))
(is (= (get-in response [:headers "Content-Type"])
"text/html")))))
(deftest head-method
(testing "not found"
(let [response ((route/not-found {:status 200
:headers {"Content-Type" "text/plain"}
:body "bar"})
(mock/request :head "/"))]
(is (= (:status response) 404))
(is (nil? (:body response)))
(is (= (get-in response [:headers "Content-Type"])
"text/plain"))))
(testing "resources"
(let [route (route/resources "/foo" {:root "test_files"})
response (route (mock/request :head "/foo/test.txt"))]
(is (= (:status response) 200))
(is (nil? (:body response)))
(is (= (get-in response [:headers "Content-Type"])
"text/plain"))))
(testing "files"
(let [route (route/files "/foo" {:root "test/test_files"})
response (route (mock/request :head "/foo/test.txt"))]
(is (= (:status response) 200))
(is (nil? (:body response)))
(is (= (get-in response [:headers "Content-Type"])
"text/plain")))))
quil/quil
(ns quil.snippets.output
(:require #?@(:clj [[quil.snippets.macro :refer [defsnippet]]
[clojure.test :refer [is]]])
[quil.core :as q :include-macros true]
quil.snippets.all-snippets-internal)
#?(:cljs
(:use-macros [quil.snippets.macro :only [defsnippet]])))
(q/camera 150 150 150 0 0 0 0 0 1)
(q/box 100)
(q/save "generated/box.png")
(comment "stop sketch after saving image")
(comment "otherwise it will show save dialog")
(comment "on every iteration")
(q/exit))
(doseq [type [:svg :pdf]
i (range 3)]
; render 3 pdf files and check that each is non-empty
; at the end
(let [file (str "generated/record_" i "." (name type))]
(q/do-record (q/create-graphics 200 200 type file)
(q/fill 255 0 0)
(q/ellipse 100 100
(+ 50 (* 50 i))
(+ 50 (* 50 i))))
(is (pos? (.length (clojure.java.io/file file))))))))
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"]))
;; use m/prefix when you only care about the first n items
(is (match? (m/prefix [odd? 3]) [1 3 5]))
;; use m/in-any-order when order doesn't matter
(is (match? (m/in-any-order [odd? odd? even?]) [1 2 3])))
(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})))))
brabster/crucible
(ns crucible.assertion
(:require [clojure.test :as test]
[crucible.encoding :as enc]))
;; clojure.test doesn't print ex-data which is a pain with clojure.spec.alpha
;; remove when ex-data is printed on test failures by default...
(defmethod test/assert-expr 'encoded-as [msg form]
(let [expected (nth form 1)
resource (nth form 2)]
`(let [result# (try (enc/rewrite-element-data ~resource)
(catch ExceptionInfo e# (ex-data e#)))]
(if (= ~expected result#)
(test/do-report {:type :pass :expected ~expected :actual ~resource :message ~msg})
(test/do-report {:type :fail :expected ~expected :actual result# :message ~msg})))))