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