rlm@10: ;   Copyright (c) Rich Hickey. All rights reserved.
rlm@10: ;   The use and distribution terms for this software are covered by the
rlm@10: ;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
rlm@10: ;   which can be found in the file epl-v10.html at the root of this distribution.
rlm@10: ;   By using this software in any fashion, you are agreeing to be bound by
rlm@10: ;   the terms of this license.
rlm@10: ;   You must not remove this notice, or any other, from this software.
rlm@10: 
rlm@10: ; Author: Stuart Halloway
rlm@10: 
rlm@10: (ns clojure.test-clojure.rt
rlm@10:   (:use clojure.test clojure.test-clojure.helpers))
rlm@10: 
rlm@10: (defmacro with-err-print-writer
rlm@10:   "Evaluate with err pointing to a temporary PrintWriter, and
rlm@10:    return err contents as a string."
rlm@10:   [& body]
rlm@10:   `(let [s# (java.io.StringWriter.)
rlm@10:          p# (java.io.PrintWriter. s#)]
rlm@10:      (binding [*err* p#]
rlm@10:        ~@body
rlm@10:        (str s#))))
rlm@10: 
rlm@10: (defmacro with-err-string-writer
rlm@10:   "Evaluate with err pointing to a temporary StringWriter, and
rlm@10:    return err contents as a string."
rlm@10:   [& body]
rlm@10:   `(let [s# (java.io.StringWriter.)]
rlm@10:      (binding [*err* s#]
rlm@10:        ~@body
rlm@10:        (str s#))))
rlm@10: 
rlm@10: (defmacro should-print-err-message
rlm@10:   "Turn on all warning flags, and test that error message prints
rlm@10:    correctly for all semi-reasonable bindings of *err*."
rlm@10:   [msg-re form]
rlm@10:   `(binding [*warn-on-reflection* true]
rlm@10:     (is (re-matches ~msg-re (with-err-string-writer (eval-in-temp-ns ~form))))
rlm@10:     (is (re-matches ~msg-re (with-err-print-writer (eval-in-temp-ns ~form))))))
rlm@10: 
rlm@10: (defn bare-rt-print
rlm@10:   "Return string RT would print prior to print-initialize"
rlm@10:   [x]
rlm@10:   (with-out-str
rlm@10:     (try
rlm@10:      (push-thread-bindings {#'clojure.core/print-initialized false})
rlm@10:      (clojure.lang.RT/print x *out*)
rlm@10:      (finally
rlm@10:       (pop-thread-bindings)))))
rlm@10: 
rlm@10: (deftest rt-print-prior-to-print-initialize
rlm@10:   (testing "pattern literals"
rlm@10:     (is (= "#\"foo\"" (bare-rt-print #"foo")))))
rlm@10: 
rlm@10: (deftest error-messages
rlm@10:   (testing "binding a core var that already refers to something"
rlm@10:     (should-print-err-message
rlm@10:      #"WARNING: prefers already refers to: #'clojure.core/prefers in namespace: .*\r?\n"
rlm@10:      (defn prefers [] (throw (RuntimeException. "rebound!")))))
rlm@10:   (testing "reflection cannot resolve field"
rlm@10:     (should-print-err-message
rlm@10:      #"Reflection warning, NO_SOURCE_PATH:\d+ - reference to field blah can't be resolved\.\r?\n"
rlm@10:      (defn foo [x] (.blah x))))
rlm@10:   (testing "reflection cannot resolve instance method"
rlm@10:     (should-print-err-message
rlm@10:      #"Reflection warning, NO_SOURCE_PATH:\d+ - call to zap can't be resolved\.\r?\n"
rlm@10:      (defn foo [x] (.zap x 1))))
rlm@10:   (testing "reflection cannot resolve static method"
rlm@10:     (should-print-err-message
rlm@10:      #"Reflection warning, NO_SOURCE_PATH:\d+ - call to valueOf can't be resolved\.\r?\n"
rlm@10:      (defn foo [] (Integer/valueOf #"boom"))))
rlm@10:   (testing "reflection cannot resolve constructor"
rlm@10:     (should-print-err-message
rlm@10:      #"Reflection warning, NO_SOURCE_PATH:\d+ - call to java.lang.String ctor can't be resolved\.\r?\n"
rlm@10:      (defn foo [] (String. 1 2 3)))))
rlm@10: 
rlm@10: (def example-var)
rlm@10: (deftest binding-root-clears-macro-metadata
rlm@10:   (alter-meta! #'example-var assoc :macro true)
rlm@10:   (is (contains? (meta #'example-var) :macro))
rlm@10:   (.bindRoot #'example-var 0)
rlm@10:   (is (not (contains? (meta #'example-var) :macro))))
rlm@10: 
rlm@10: (deftest last-var-wins-for-core
rlm@10:   (testing "you can replace a core name, with warning"
rlm@10:     (let [ns (temp-ns)
rlm@10:         replacement (gensym)]
rlm@10:       (with-err-string-writer (intern ns 'prefers replacement))
rlm@10:       (is (= replacement @('prefers (ns-publics ns))))))
rlm@10:   (testing "you can replace a name you defined before"
rlm@10:     (let [ns (temp-ns)
rlm@10:           s (gensym)
rlm@10:           v1 (intern ns 'foo s)
rlm@10:           v2 (intern ns 'bar s)]
rlm@10:       (with-err-string-writer (.refer ns 'flatten v1))
rlm@10:       (.refer ns 'flatten v2)
rlm@10:       (is (= v2 (ns-resolve ns 'flatten)))))
rlm@10:   (testing "you cannot intern over an existing non-core name"
rlm@10:     (let [ns (temp-ns 'clojure.set)
rlm@10:           replacement (gensym)]
rlm@10:       (is (thrown? IllegalStateException
rlm@10:                    (intern ns 'subset? replacement)))
rlm@10:       (is (nil? ('subset? (ns-publics ns))))
rlm@10:       (is (= #'clojure.set/subset? ('subset? (ns-refers ns))))))
rlm@10:   (testing "you cannot refer over an existing non-core name"
rlm@10:     (let [ns (temp-ns 'clojure.set)
rlm@10:           replacement (gensym)]
rlm@10:       (is (thrown? IllegalStateException
rlm@10:                    (.refer ns 'subset? #'clojure.set/intersection)))
rlm@10:       (is (nil? ('subset? (ns-publics ns))))
rlm@10:       (is (= #'clojure.set/subset? ('subset? (ns-refers ns)))))))