1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/test_clojure/rt.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,111 @@
     1.4 +;   Copyright (c) Rich Hickey. All rights reserved.
     1.5 +;   The use and distribution terms for this software are covered by the
     1.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
     1.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
     1.8 +;   By using this software in any fashion, you are agreeing to be bound by
     1.9 +;   the terms of this license.
    1.10 +;   You must not remove this notice, or any other, from this software.
    1.11 +
    1.12 +; Author: Stuart Halloway
    1.13 +
    1.14 +(ns clojure.test-clojure.rt
    1.15 +  (:use clojure.test clojure.test-clojure.helpers))
    1.16 +
    1.17 +(defmacro with-err-print-writer
    1.18 +  "Evaluate with err pointing to a temporary PrintWriter, and
    1.19 +   return err contents as a string."
    1.20 +  [& body]
    1.21 +  `(let [s# (java.io.StringWriter.)
    1.22 +         p# (java.io.PrintWriter. s#)]
    1.23 +     (binding [*err* p#]
    1.24 +       ~@body
    1.25 +       (str s#))))
    1.26 +
    1.27 +(defmacro with-err-string-writer
    1.28 +  "Evaluate with err pointing to a temporary StringWriter, and
    1.29 +   return err contents as a string."
    1.30 +  [& body]
    1.31 +  `(let [s# (java.io.StringWriter.)]
    1.32 +     (binding [*err* s#]
    1.33 +       ~@body
    1.34 +       (str s#))))
    1.35 +
    1.36 +(defmacro should-print-err-message
    1.37 +  "Turn on all warning flags, and test that error message prints
    1.38 +   correctly for all semi-reasonable bindings of *err*."
    1.39 +  [msg-re form]
    1.40 +  `(binding [*warn-on-reflection* true]
    1.41 +    (is (re-matches ~msg-re (with-err-string-writer (eval-in-temp-ns ~form))))
    1.42 +    (is (re-matches ~msg-re (with-err-print-writer (eval-in-temp-ns ~form))))))
    1.43 +
    1.44 +(defn bare-rt-print
    1.45 +  "Return string RT would print prior to print-initialize"
    1.46 +  [x]
    1.47 +  (with-out-str
    1.48 +    (try
    1.49 +     (push-thread-bindings {#'clojure.core/print-initialized false})
    1.50 +     (clojure.lang.RT/print x *out*)
    1.51 +     (finally
    1.52 +      (pop-thread-bindings)))))
    1.53 +
    1.54 +(deftest rt-print-prior-to-print-initialize
    1.55 +  (testing "pattern literals"
    1.56 +    (is (= "#\"foo\"" (bare-rt-print #"foo")))))
    1.57 +
    1.58 +(deftest error-messages
    1.59 +  (testing "binding a core var that already refers to something"
    1.60 +    (should-print-err-message
    1.61 +     #"WARNING: prefers already refers to: #'clojure.core/prefers in namespace: .*\r?\n"
    1.62 +     (defn prefers [] (throw (RuntimeException. "rebound!")))))
    1.63 +  (testing "reflection cannot resolve field"
    1.64 +    (should-print-err-message
    1.65 +     #"Reflection warning, NO_SOURCE_PATH:\d+ - reference to field blah can't be resolved\.\r?\n"
    1.66 +     (defn foo [x] (.blah x))))
    1.67 +  (testing "reflection cannot resolve instance method"
    1.68 +    (should-print-err-message
    1.69 +     #"Reflection warning, NO_SOURCE_PATH:\d+ - call to zap can't be resolved\.\r?\n"
    1.70 +     (defn foo [x] (.zap x 1))))
    1.71 +  (testing "reflection cannot resolve static method"
    1.72 +    (should-print-err-message
    1.73 +     #"Reflection warning, NO_SOURCE_PATH:\d+ - call to valueOf can't be resolved\.\r?\n"
    1.74 +     (defn foo [] (Integer/valueOf #"boom"))))
    1.75 +  (testing "reflection cannot resolve constructor"
    1.76 +    (should-print-err-message
    1.77 +     #"Reflection warning, NO_SOURCE_PATH:\d+ - call to java.lang.String ctor can't be resolved\.\r?\n"
    1.78 +     (defn foo [] (String. 1 2 3)))))
    1.79 +
    1.80 +(def example-var)
    1.81 +(deftest binding-root-clears-macro-metadata
    1.82 +  (alter-meta! #'example-var assoc :macro true)
    1.83 +  (is (contains? (meta #'example-var) :macro))
    1.84 +  (.bindRoot #'example-var 0)
    1.85 +  (is (not (contains? (meta #'example-var) :macro))))
    1.86 +
    1.87 +(deftest last-var-wins-for-core
    1.88 +  (testing "you can replace a core name, with warning"
    1.89 +    (let [ns (temp-ns)
    1.90 +        replacement (gensym)]
    1.91 +      (with-err-string-writer (intern ns 'prefers replacement))
    1.92 +      (is (= replacement @('prefers (ns-publics ns))))))
    1.93 +  (testing "you can replace a name you defined before"
    1.94 +    (let [ns (temp-ns)
    1.95 +          s (gensym)
    1.96 +          v1 (intern ns 'foo s)
    1.97 +          v2 (intern ns 'bar s)]
    1.98 +      (with-err-string-writer (.refer ns 'flatten v1))
    1.99 +      (.refer ns 'flatten v2)
   1.100 +      (is (= v2 (ns-resolve ns 'flatten)))))
   1.101 +  (testing "you cannot intern over an existing non-core name"
   1.102 +    (let [ns (temp-ns 'clojure.set)
   1.103 +          replacement (gensym)]
   1.104 +      (is (thrown? IllegalStateException
   1.105 +                   (intern ns 'subset? replacement)))
   1.106 +      (is (nil? ('subset? (ns-publics ns))))
   1.107 +      (is (= #'clojure.set/subset? ('subset? (ns-refers ns))))))
   1.108 +  (testing "you cannot refer over an existing non-core name"
   1.109 +    (let [ns (temp-ns 'clojure.set)
   1.110 +          replacement (gensym)]
   1.111 +      (is (thrown? IllegalStateException
   1.112 +                   (.refer ns 'subset? #'clojure.set/intersection)))
   1.113 +      (is (nil? ('subset? (ns-publics ns))))
   1.114 +      (is (= #'clojure.set/subset? ('subset? (ns-refers ns)))))))