Mercurial > lasercutter

     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)))))))
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 21 Aug 2010 06:25:44 -0400
parents
children