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: 
rlm@10: ;;  Tests for the Clojure functions documented at the URL:
rlm@10: ;;
rlm@10: ;;    http://clojure.org/Evaluation
rlm@10: ;;
rlm@10: ;;  by J. McConnell
rlm@10: ;;  Created 22 October 2008
rlm@10: 
rlm@10: (ns clojure.test-clojure.evaluation
rlm@10:   (:use clojure.test))
rlm@10: 
rlm@10: (import '(java.lang Boolean)
rlm@10:         '(clojure.lang Compiler Compiler$CompilerException))
rlm@10: 
rlm@10: (defmacro test-that
rlm@10:   "Provides a useful way for specifying the purpose of tests. If the first-level
rlm@10:   forms are lists that make a call to a clojure.test function, it supplies the
rlm@10:   purpose as the msg argument to those functions. Otherwise, the purpose just
rlm@10:   acts like a comment and the forms are run unchanged."
rlm@10:   [purpose & test-forms]
rlm@10:   (let [tests (map
rlm@10:                 #(if (= (:ns (meta (resolve (first %))))
rlm@10:                         (the-ns 'clojure.test))
rlm@10:                    (concat % (list purpose))
rlm@10:                    %)
rlm@10:                 test-forms)]
rlm@10:     `(do ~@tests)))
rlm@10: 
rlm@10: (deftest Eval
rlm@10:   (is (= (eval '(+ 1 2 3)) (Compiler/eval '(+ 1 2 3))))
rlm@10:   (is (= (eval '(list 1 2 3)) '(1 2 3)))
rlm@10:   (is (= (eval '(list + 1 2 3)) (list clojure.core/+ 1 2 3)))
rlm@10:   (test-that "Non-closure fns are supported as code"
rlm@10:              (is (= (eval (eval '(list + 1 2 3))) 6)))
rlm@10:   (is (= (eval (list '+ 1 2 3)) 6)))
rlm@10: 
rlm@10: ; not using Clojure's RT/classForName since a bug in it could hide a bug in
rlm@10: ; eval's resolution
rlm@10: (defn class-for-name [name]
rlm@10:   (java.lang.Class/forName name))
rlm@10: 
rlm@10: (defmacro in-test-ns [& body]
rlm@10:   `(binding [*ns* *ns*]
rlm@10:      (in-ns 'clojure.test-clojure.evaluation)
rlm@10:      ~@body))
rlm@10: 
rlm@10: ;;; Literals tests ;;;
rlm@10: 
rlm@10: (defmacro #^{:private true} evaluates-to-itself? [expr]
rlm@10:   `(let [v# ~expr
rlm@10:          q# (quote ~expr)]
rlm@10:      (is (= (eval q#) q#) (str q# " does not evaluate to itself"))))
rlm@10: 
rlm@10: (deftest Literals
rlm@10:   ; Strings, numbers, characters, nil and keywords should evaluate to themselves
rlm@10:   (evaluates-to-itself? "test")
rlm@10:   (evaluates-to-itself? "test
rlm@10:                         multi-line
rlm@10:                         string")
rlm@10:   (evaluates-to-itself? 1)
rlm@10:   (evaluates-to-itself? 1.0)
rlm@10:   (evaluates-to-itself? 1.123456789)
rlm@10:   (evaluates-to-itself? 1/2)
rlm@10:   (evaluates-to-itself? 1M)
rlm@10:   (evaluates-to-itself? 999999999999999999)
rlm@10:   (evaluates-to-itself? \a)
rlm@10:   (evaluates-to-itself? \newline)
rlm@10:   (evaluates-to-itself? nil)
rlm@10:   (evaluates-to-itself? :test)
rlm@10:   ; Boolean literals should evaluate to Boolean.{TRUE|FALSE}
rlm@10:   (is (identical? (eval true) Boolean/TRUE))
rlm@10:   (is (identical? (eval false) Boolean/FALSE)))
rlm@10: 
rlm@10: ;;; Symbol resolution tests ;;;
rlm@10: 
rlm@10: (def foo "abc")
rlm@10: (in-ns 'resolution-test)
rlm@10: (def bar 123)
rlm@10: (def #^{:private true} baz 456)
rlm@10: (in-ns 'clojure.test-clojure.evaluation)
rlm@10: 
rlm@10: (defn a-match? [re s] (not (nil? (re-matches re s))))
rlm@10: 
rlm@10: (defmacro throws-with-msg
rlm@10:   ([re form] `(throws-with-msg ~re ~form Exception))
rlm@10:   ([re form x] `(throws-with-msg
rlm@10:                   ~re
rlm@10:                   ~form
rlm@10:                   ~(if (instance? Exception x) x Exception)
rlm@10:                   ~(if (instance? String x) x nil)))
rlm@10:   ([re form class msg]
rlm@10:        `(let [ex# (try
rlm@10:                     ~form
rlm@10:                     (catch ~class e# e#)
rlm@10:                     (catch Exception e#
rlm@10:                       (let [cause# (.getCause e#)]
rlm@10:                         (if (= ~class (class cause#)) cause# (throw e#)))))]
rlm@10:           (is (a-match? ~re (.toString ex#))
rlm@10:               (or ~msg
rlm@10:                   (str "Expected exception that matched " (pr-str ~re)
rlm@10:                        ", but got exception with message: \"" ex#))))))
rlm@10: 
rlm@10: (deftest SymbolResolution
rlm@10:   (test-that
rlm@10:     "If a symbol is namespace-qualified, the evaluated value is the value
rlm@10:      of the binding of the global var named by the symbol"
rlm@10:     (is (= (eval 'resolution-test/bar) 123)))
rlm@10: 
rlm@10:   (test-that
rlm@10:     "It is an error if there is no global var named by the symbol"
rlm@10:     (throws-with-msg
rlm@10:       #".*Unable to resolve symbol: bar.*" (eval 'bar)))
rlm@10: 
rlm@10:   (test-that
rlm@10:     "It is an error if the symbol reference is to a non-public var in a
rlm@10:     different namespace"
rlm@10:     (throws-with-msg
rlm@10:       #".*resolution-test/baz is not public.*"
rlm@10:       (eval 'resolution-test/baz)
rlm@10:       Compiler$CompilerException))
rlm@10: 
rlm@10:   (test-that
rlm@10:     "If a symbol is package-qualified, its value is the Java class named by the
rlm@10:     symbol"
rlm@10:     (is (= (eval 'java.lang.Math) (class-for-name "java.lang.Math"))))
rlm@10: 
rlm@10:   (test-that
rlm@10:     "If a symbol is package-qualified, it is an error if there is no Class named
rlm@10:     by the symbol"
rlm@10:     (is (thrown? Compiler$CompilerException (eval 'java.lang.FooBar))))
rlm@10: 
rlm@10:   (test-that
rlm@10:     "If a symbol is not qualified, the following applies, in this order:
rlm@10: 
rlm@10:       1. If it names a special form it is considered a special form, and must
rlm@10:          be utilized accordingly.
rlm@10: 
rlm@10:       2. A lookup is done in the current namespace to see if there is a mapping
rlm@10:          from the symbol to a class. If so, the symbol is considered to name a
rlm@10:          Java class object.
rlm@10: 
rlm@10:       3. If in a local scope (i.e. in a function definition), a lookup is done
rlm@10:          to see if it names a local binding (e.g. a function argument or
rlm@10:          let-bound name). If so, the value is the value of the local binding.
rlm@10: 
rlm@10:       4. A lookup is done in the current namespace to see if there is a mapping
rlm@10:          from the symbol to a var. If so, the value is the value of the binding
rlm@10:          of the var referred-to by the symbol.
rlm@10: 
rlm@10:       5. It is an error."
rlm@10: 
rlm@10:     ; First
rlm@10:     (doall (for [form '(def if do let quote var fn loop recur throw try
rlm@10:                          monitor-enter monitor-exit)]
rlm@10:              (is (thrown? Compiler$CompilerException (eval form)))))
rlm@10:     (let [if "foo"]
rlm@10:       (is (thrown? Compiler$CompilerException (eval 'if)))
rlm@10: 
rlm@10:     ; Second
rlm@10:       (is (= (eval 'Boolean) (class-for-name "java.lang.Boolean"))))
rlm@10:     (let [Boolean "foo"]
rlm@10:       (is (= (eval 'Boolean) (class-for-name "java.lang.Boolean"))))
rlm@10: 
rlm@10:     ; Third
rlm@10:     (is (= (eval '(let [foo "bar"] foo)) "bar"))
rlm@10: 
rlm@10:     ; Fourth
rlm@10:     (in-test-ns (is (= (eval 'foo) "abc")))
rlm@10:     (is (thrown? Compiler$CompilerException (eval 'bar))) ; not in this namespace
rlm@10: 
rlm@10:     ; Fifth
rlm@10:     (is (thrown? Compiler$CompilerException (eval 'foobar)))))
rlm@10: 
rlm@10: ;;; Metadata tests ;;;
rlm@10: 
rlm@10: (defstruct struct-with-symbols (with-meta 'k {:a "A"}))
rlm@10: 
rlm@10: (deftest Metadata
rlm@10: 
rlm@10:   (test-that
rlm@10:     "find returns key symbols and their metadata"
rlm@10:     (let [s (struct struct-with-symbols 1)]
rlm@10:       (is (= {:a "A"} (meta (first (find s 'k))))))))
rlm@10: 
rlm@10: ;;; Collections tests ;;;
rlm@10: (def x 1)
rlm@10: (def y 2)
rlm@10: 
rlm@10: (deftest Collections
rlm@10:   (in-test-ns
rlm@10:     (test-that
rlm@10:       "Vectors and Maps yield vectors and (hash) maps whose contents are the
rlm@10:       evaluated values of the objects they contain."
rlm@10:       (is (= (eval '[x y 3]) [1 2 3]))
rlm@10:       (is (= (eval '{:x x :y y :z 3}) {:x 1 :y 2 :z 3}))
rlm@10:       (is (instance? clojure.lang.IPersistentMap (eval '{:x x :y y})))))
rlm@10: 
rlm@10:   (in-test-ns
rlm@10:     (test-that
rlm@10:       "Metadata maps yield maps whose contents are the evaluated values of
rlm@10:       the objects they contain. If a vector or map has metadata, the evaluated
rlm@10:       metadata map will become the metadata of the resulting value."
rlm@10:       (is (= (eval #^{:x x} '[x y]) #^{:x 1} [1 2]))))
rlm@10: 
rlm@10:   (test-that
rlm@10:     "An empty list () evaluates to an empty list."
rlm@10:     (is (= (eval '()) ()))
rlm@10:     (is (empty? (eval ())))
rlm@10:     (is (= (eval (list)) ())))
rlm@10: 
rlm@10:   (test-that
rlm@10:     "Non-empty lists are considered calls"
rlm@10:     (is (thrown? Compiler$CompilerException (eval '(1 2 3))))))
rlm@10: 
rlm@10: (deftest Macros)
rlm@10: 
rlm@10: (deftest Loading)