annotate 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
rev   line source
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)))))))