rlm@10
|
1 ; Copyright (c) Rich Hickey. All rights reserved.
|
rlm@10
|
2 ; The use and distribution terms for this software are covered by the
|
rlm@10
|
3 ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
|
rlm@10
|
4 ; which can be found in the file epl-v10.html at the root of this distribution.
|
rlm@10
|
5 ; By using this software in any fashion, you are agreeing to be bound by
|
rlm@10
|
6 ; the terms of this license.
|
rlm@10
|
7 ; You must not remove this notice, or any other, from this software.
|
rlm@10
|
8
|
rlm@10
|
9 ; Author: Stuart Halloway
|
rlm@10
|
10
|
rlm@10
|
11 (ns clojure.test-clojure.rt
|
rlm@10
|
12 (:use clojure.test clojure.test-clojure.helpers))
|
rlm@10
|
13
|
rlm@10
|
14 (defmacro with-err-print-writer
|
rlm@10
|
15 "Evaluate with err pointing to a temporary PrintWriter, and
|
rlm@10
|
16 return err contents as a string."
|
rlm@10
|
17 [& body]
|
rlm@10
|
18 `(let [s# (java.io.StringWriter.)
|
rlm@10
|
19 p# (java.io.PrintWriter. s#)]
|
rlm@10
|
20 (binding [*err* p#]
|
rlm@10
|
21 ~@body
|
rlm@10
|
22 (str s#))))
|
rlm@10
|
23
|
rlm@10
|
24 (defmacro with-err-string-writer
|
rlm@10
|
25 "Evaluate with err pointing to a temporary StringWriter, and
|
rlm@10
|
26 return err contents as a string."
|
rlm@10
|
27 [& body]
|
rlm@10
|
28 `(let [s# (java.io.StringWriter.)]
|
rlm@10
|
29 (binding [*err* s#]
|
rlm@10
|
30 ~@body
|
rlm@10
|
31 (str s#))))
|
rlm@10
|
32
|
rlm@10
|
33 (defmacro should-print-err-message
|
rlm@10
|
34 "Turn on all warning flags, and test that error message prints
|
rlm@10
|
35 correctly for all semi-reasonable bindings of *err*."
|
rlm@10
|
36 [msg-re form]
|
rlm@10
|
37 `(binding [*warn-on-reflection* true]
|
rlm@10
|
38 (is (re-matches ~msg-re (with-err-string-writer (eval-in-temp-ns ~form))))
|
rlm@10
|
39 (is (re-matches ~msg-re (with-err-print-writer (eval-in-temp-ns ~form))))))
|
rlm@10
|
40
|
rlm@10
|
41 (defn bare-rt-print
|
rlm@10
|
42 "Return string RT would print prior to print-initialize"
|
rlm@10
|
43 [x]
|
rlm@10
|
44 (with-out-str
|
rlm@10
|
45 (try
|
rlm@10
|
46 (push-thread-bindings {#'clojure.core/print-initialized false})
|
rlm@10
|
47 (clojure.lang.RT/print x *out*)
|
rlm@10
|
48 (finally
|
rlm@10
|
49 (pop-thread-bindings)))))
|
rlm@10
|
50
|
rlm@10
|
51 (deftest rt-print-prior-to-print-initialize
|
rlm@10
|
52 (testing "pattern literals"
|
rlm@10
|
53 (is (= "#\"foo\"" (bare-rt-print #"foo")))))
|
rlm@10
|
54
|
rlm@10
|
55 (deftest error-messages
|
rlm@10
|
56 (testing "binding a core var that already refers to something"
|
rlm@10
|
57 (should-print-err-message
|
rlm@10
|
58 #"WARNING: prefers already refers to: #'clojure.core/prefers in namespace: .*\r?\n"
|
rlm@10
|
59 (defn prefers [] (throw (RuntimeException. "rebound!")))))
|
rlm@10
|
60 (testing "reflection cannot resolve field"
|
rlm@10
|
61 (should-print-err-message
|
rlm@10
|
62 #"Reflection warning, NO_SOURCE_PATH:\d+ - reference to field blah can't be resolved\.\r?\n"
|
rlm@10
|
63 (defn foo [x] (.blah x))))
|
rlm@10
|
64 (testing "reflection cannot resolve instance method"
|
rlm@10
|
65 (should-print-err-message
|
rlm@10
|
66 #"Reflection warning, NO_SOURCE_PATH:\d+ - call to zap can't be resolved\.\r?\n"
|
rlm@10
|
67 (defn foo [x] (.zap x 1))))
|
rlm@10
|
68 (testing "reflection cannot resolve static method"
|
rlm@10
|
69 (should-print-err-message
|
rlm@10
|
70 #"Reflection warning, NO_SOURCE_PATH:\d+ - call to valueOf can't be resolved\.\r?\n"
|
rlm@10
|
71 (defn foo [] (Integer/valueOf #"boom"))))
|
rlm@10
|
72 (testing "reflection cannot resolve constructor"
|
rlm@10
|
73 (should-print-err-message
|
rlm@10
|
74 #"Reflection warning, NO_SOURCE_PATH:\d+ - call to java.lang.String ctor can't be resolved\.\r?\n"
|
rlm@10
|
75 (defn foo [] (String. 1 2 3)))))
|
rlm@10
|
76
|
rlm@10
|
77 (def example-var)
|
rlm@10
|
78 (deftest binding-root-clears-macro-metadata
|
rlm@10
|
79 (alter-meta! #'example-var assoc :macro true)
|
rlm@10
|
80 (is (contains? (meta #'example-var) :macro))
|
rlm@10
|
81 (.bindRoot #'example-var 0)
|
rlm@10
|
82 (is (not (contains? (meta #'example-var) :macro))))
|
rlm@10
|
83
|
rlm@10
|
84 (deftest last-var-wins-for-core
|
rlm@10
|
85 (testing "you can replace a core name, with warning"
|
rlm@10
|
86 (let [ns (temp-ns)
|
rlm@10
|
87 replacement (gensym)]
|
rlm@10
|
88 (with-err-string-writer (intern ns 'prefers replacement))
|
rlm@10
|
89 (is (= replacement @('prefers (ns-publics ns))))))
|
rlm@10
|
90 (testing "you can replace a name you defined before"
|
rlm@10
|
91 (let [ns (temp-ns)
|
rlm@10
|
92 s (gensym)
|
rlm@10
|
93 v1 (intern ns 'foo s)
|
rlm@10
|
94 v2 (intern ns 'bar s)]
|
rlm@10
|
95 (with-err-string-writer (.refer ns 'flatten v1))
|
rlm@10
|
96 (.refer ns 'flatten v2)
|
rlm@10
|
97 (is (= v2 (ns-resolve ns 'flatten)))))
|
rlm@10
|
98 (testing "you cannot intern over an existing non-core name"
|
rlm@10
|
99 (let [ns (temp-ns 'clojure.set)
|
rlm@10
|
100 replacement (gensym)]
|
rlm@10
|
101 (is (thrown? IllegalStateException
|
rlm@10
|
102 (intern ns 'subset? replacement)))
|
rlm@10
|
103 (is (nil? ('subset? (ns-publics ns))))
|
rlm@10
|
104 (is (= #'clojure.set/subset? ('subset? (ns-refers ns))))))
|
rlm@10
|
105 (testing "you cannot refer over an existing non-core name"
|
rlm@10
|
106 (let [ns (temp-ns 'clojure.set)
|
rlm@10
|
107 replacement (gensym)]
|
rlm@10
|
108 (is (thrown? IllegalStateException
|
rlm@10
|
109 (.refer ns 'subset? #'clojure.set/intersection)))
|
rlm@10
|
110 (is (nil? ('subset? (ns-publics ns))))
|
rlm@10
|
111 (is (= #'clojure.set/subset? ('subset? (ns-refers ns)))))))
|