diff options
| author | Rich Hickey <richhickey@gmail.com> | 2009-07-14 20:11:22 -0400 |
|---|---|---|
| committer | Rich Hickey <richhickey@gmail.com> | 2009-07-14 20:11:22 -0400 |
| commit | 1ac552bb74ce96df21fa870e57b0fbf5e336c9f0 (patch) | |
| tree | 2a81916605700d8fe06eec47e054f38b2d44c3a7 | |
| parent | 9b6b549df3d2d835f6c2305e6962e31b21b374af (diff) | |
| parent | 12888faab8f5c7bc13da5a8f506c2a594c48500c (diff) | |
Merge branch 'master' into chunks
43 files changed, 6046 insertions, 55 deletions
@@ -9,6 +9,7 @@ </description> <property name="src" location="src"/> + <property name="test" location="test"/> <property name="jsrc" location="${src}/jvm"/> <property name="cljsrc" location="${src}/clj"/> <property name="build" location="classes"/> @@ -92,6 +93,11 @@ <arg value="clojure.xml"/> <arg value="clojure.zip"/> <arg value="clojure.inspector"/> + <arg value="clojure.walk"/> + <arg value="clojure.stacktrace"/> + <arg value="clojure.template"/> + <arg value="clojure.test"/> + <arg value="clojure.test.tap"/> </java> </target> @@ -110,6 +116,19 @@ <copy file="${clojure_jar}" tofile="${clojure_noversion_jar}" /> </target> + <target name="test" + description="Run clojure tests"> +<!-- depends="clojure"> --> + <java classname="clojure.main"> + <classpath> + <path location="${test}"/> + <path location="${clojure_jar}"/> + </classpath> + <arg value="-e"/> + <arg value="(require '(clojure [test-clojure :as main])) (main/run)"/> + </java> + </target> + <target name="clojure-slim" depends="compile-java" description="Create clojure-slim jar file (omits compiled Clojure code)"> <jar jarfile="${slim_jar}"> diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj index 6b7661fb..8ed4aaf1 100644 --- a/src/clj/clojure/core.clj +++ b/src/clj/clojure/core.clj @@ -129,17 +129,6 @@ vector? (fn vector? [x] (instance? clojure.lang.IPersistentVector x))) (def - #^{:private true} - sigs - (fn [fdecl] - (if (seq? (first fdecl)) - (loop [ret [] fdecl fdecl] - (if fdecl - (recur (conj ret (first (first fdecl))) (next fdecl)) - (seq ret))) - (list (first fdecl))))) - -(def #^{:arglists '([map key val] [map key val & kvs]) :doc "assoc[iate]. When applied to a map, returns a new map of the same (hashed/sorted) type, that contains the mapping of key(s) to @@ -169,6 +158,27 @@ with-meta (fn with-meta [#^clojure.lang.IObj x m] (. x (withMeta m)))) +(def + #^{:private true} + sigs + (fn [fdecl] + (let [asig + (fn [fdecl] + (let [arglist (first fdecl) + body (next fdecl)] + (if (map? (first body)) + (if (next body) + (with-meta arglist (conj (if (meta arglist) (meta arglist) {}) (first body))) + arglist) + arglist)))] + (if (seq? (first fdecl)) + (loop [ret [] fdecls fdecl] + (if fdecls + (recur (conj ret (asig (first fdecls))) (next fdecls)) + (seq ret))) + (list (asig fdecl)))))) + + (def #^{:arglists '([coll]) :doc "Return the last item in coll, in linear time"} @@ -1300,14 +1310,30 @@ :validator validate-fn + :min-history (default 0) + :max-history (default 10) + If metadata-map is supplied, it will be come the metadata on the ref. validate-fn must be nil or a side-effect-free fn of one argument, which will be passed the intended new state on any state change. If the new state is unacceptable, the validate-fn should return false or throw an exception. validate-fn will be called on - transaction commit, when all refs have their final values." + transaction commit, when all refs have their final values. + + Normally refs accumulate history dynamically as needed to deal with + read demands. If you know in advance you will need history you can + set :min-history to ensure it will be available when first needed (instead + of after a read fault). History is limited, and the limit can be set + with :max-history." ([x] (new clojure.lang.Ref x)) - ([x & options] (setup-reference (ref x) options))) + ([x & options] + (let [r #^clojure.lang.Ref (setup-reference (ref x) options) + opts (apply hash-map options)] + (when (:max-history opts) + (.setMaxHistory r (:max-history opts))) + (when (:min-history opts) + (.setMinHistory r (:min-history opts))) + r))) (defn deref "Also reader macro: @ref/@agent/@var/@atom/@delay/@future. Within a transaction, @@ -1415,6 +1441,25 @@ [#^clojure.lang.Ref ref val] (. ref (set val))) +(defn ref-history-count + "Returns the history count of a ref" + [#^clojure.lang.Ref ref] + (.getHistoryCount ref)) + +(defn ref-min-history + "Gets the min-history of a ref, or sets it and returns the ref" + ([#^clojure.lang.Ref ref] + (.getMinHistory ref)) + ([#^clojure.lang.Ref ref n] + (.setMinHistory ref n))) + +(defn ref-max-history + "Gets the max-history of a ref, or sets it and returns the ref" + ([#^clojure.lang.Ref ref] + (.getMaxHistory ref)) + ([#^clojure.lang.Ref ref n] + (.setMaxHistory ref n))) + (defn ensure "Must be called in a transaction. Protects the ref from modification by other transactions. Returns the in-transaction-value of @@ -1497,10 +1542,10 @@ false." {:tag Boolean} [pred coll] - (if (seq coll) - (and (pred (first coll)) - (recur pred (next coll))) - true)) + (cond + (nil? (seq coll)) true + (pred (first coll)) (recur pred (next coll)) + :else false)) (def #^{:tag Boolean @@ -1778,15 +1823,24 @@ (defn partition "Returns a lazy sequence of lists of n items each, at offsets step apart. If step is not supplied, defaults to n, i.e. the partitions - do not overlap." + do not overlap. If a pad collection is supplied, use its elements as + necessary to complete last partition upto n items. In case there are + not enough padding elements, return a partition with less than n items." ([n coll] (partition n n coll)) ([n step coll] - (lazy-seq - (when-let [s (seq coll)] - (let [p (take n s)] - (when (= n (count p)) - (cons p (partition n step (drop step s))))))))) + (lazy-seq + (when-let [s (seq coll)] + (let [p (take n s)] + (when (= n (count p)) + (cons p (partition n step (drop step s)))))))) + ([n step pad coll] + (lazy-seq + (when-let [s (seq coll)] + (let [p (take n s)] + (if (= n (count p)) + (cons p (partition n step pad (drop step s))) + (list (take n (concat p pad))))))))) ;; evaluation @@ -2657,7 +2711,7 @@ (even? (count bindings)) "an even number of forms in binding vector") `(let* ~(destructure bindings) ~@body)) -;redefine fn with destructuring +;redefine fn with destructuring and pre/post conditions (defmacro fn "(fn name? [params* ] exprs*) (fn name? ([params* ] exprs*)+) @@ -2673,9 +2727,26 @@ sigs (if name (next sigs) sigs) sigs (if (vector? (first sigs)) (list sigs) sigs) psig (fn [sig] - (let [[params & body] sig] + (let [[params & body] sig + conds (when (and (next body) (map? (first body))) + (first body)) + body (if conds (next body) body) + conds (or conds ^params) + pre (:pre conds) + post (:post conds) + body (if post + `((let [~'% ~(if (< 1 (count body)) + `(do ~@body) + (first body))] + ~@(map (fn [c] `(assert ~c)) post) + ~'%)) + body) + body (if pre + (concat (map (fn [c] `(assert ~c)) pre) + body) + body)] (if (every? symbol? params) - sig + (cons params body) (loop [params params new-params [] lets []] @@ -2844,8 +2915,9 @@ "Evaluates expr and throws an exception if it does not evaluate to logical true." [x] - `(when-not ~x - (throw (new Exception (str "Assert failed: " (pr-str '~x)))))) + (when *assert* + `(when-not ~x + (throw (new Exception (str "Assert failed: " (pr-str '~x))))))) (defn test "test [v] finds fn at key :test in var metadata and calls it, @@ -3034,16 +3106,20 @@ [v] (instance? clojure.lang.Var v)) (defn slurp - "Reads the file named by f into a string and returns it." - [#^String f] - (with-open [r (new java.io.BufferedReader (new java.io.FileReader f))] + "Reads the file named by f using the encoding enc into a string + and returns it." + ([f] (slurp f (.name (java.nio.charset.Charset/defaultCharset)))) + ([#^String f #^String enc] + (with-open [r (new java.io.BufferedReader + (new java.io.InputStreamReader + (new java.io.FileInputStream f) enc))] (let [sb (new StringBuilder)] - (loop [c (. r (read))] + (loop [c (.read r)] (if (neg? c) (str sb) (do - (. sb (append (char c))) - (recur (. r (read))))))))) + (.append sb (char c)) + (recur (.read r))))))))) (defn subs "Returns the substring of s beginning at start inclusive, and ending @@ -3735,11 +3811,11 @@ All definitions a lib makes should be in its associated namespace. 'require loads a lib by loading its root resource. The root resource path - is derived from the root directory path by repeating its last component - and appending '.clj'. For example, the lib 'x.y.z has root directory - <classpath>/x/y/z; root resource <classpath>/x/y/z/z.clj. The root - resource should contain code to create the lib's namespace and load any - additional lib resources. + is derived from the lib name in the following manner: + Consider a lib named by the symbol 'x.y.z; it has the root directory + <classpath>/x/y/, and its root resource is <classpath>/x/y/z.clj. The root + resource should contain code to create the lib's namespace (usually by using + the ns macro) and load any additional lib resources. Libspecs @@ -3766,7 +3842,14 @@ already loaded :reload-all implies :reload and also forces loading of all libs that the identified libs directly or indirectly load via require or use - :verbose triggers printing information about each load, alias, and refer" + :verbose triggers printing information about each load, alias, and refer + + Example: + + The following would load the libraries clojure.zip and clojure.set + abbreviated as 's'. + + (require '(clojure zip [set :as s]))" [& args] (apply load-libs :require args)) diff --git a/src/clj/clojure/main.clj b/src/clj/clojure/main.clj index ee185afe..58fa0a3f 100644 --- a/src/clj/clojure/main.clj +++ b/src/clj/clojure/main.clj @@ -16,17 +16,19 @@ (defmacro with-bindings "Executes body in the context of thread-local bindings for several vars - that often need to be set!: *ns* *warn-on-reflection* *print-meta* - *print-length* *print-level* *compile-path* *command-line-args* *1 - *2 *3 *e" + that often need to be set!: *ns* *warn-on-reflection* *math-context* + *print-meta* *print-length* *print-level* *compile-path* + *command-line-args* *1 *2 *3 *e" [& body] `(binding [*ns* *ns* *warn-on-reflection* *warn-on-reflection* + *math-context* *math-context* *print-meta* *print-meta* *print-length* *print-length* *print-level* *print-level* *compile-path* (System/getProperty "clojure.compile.path" "classes") *command-line-args* *command-line-args* + *assert* *assert* *1 nil *2 nil *3 nil diff --git a/src/clj/clojure/stacktrace.clj b/src/clj/clojure/stacktrace.clj new file mode 100644 index 00000000..52d03b9b --- /dev/null +++ b/src/clj/clojure/stacktrace.clj @@ -0,0 +1,74 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +;;; stacktrace.clj: print Clojure-centric stack traces + +;; by Stuart Sierra +;; January 6, 2009 + +(ns + #^{:author "Stuart Sierra", + :doc "Print Clojure-centric stack traces"} + clojure.stacktrace) + +(defn root-cause + "Returns the last 'cause' Throwable in a chain of Throwables." + [tr] + (if-let [cause (.getCause tr)] + (recur cause) + tr)) + +(defn print-trace-element + "Prints a Clojure-oriented view of one element in a stack trace." + [e] + (let [class (.getClassName e) + method (.getMethodName e)] + (let [match (re-matches #"^([A-Za-z0-9_.-]+)\$(\w+)__\d+$" class)] + (if (and match (= "invoke" method)) + (apply printf "%s/%s" (rest match)) + (printf "%s.%s" class method)))) + (printf " (%s:%d)" (or (.getFileName e) "") (.getLineNumber e))) + +(defn print-throwable + "Prints the class and message of a Throwable." + [tr] + (printf "%s: %s" (.getName (class tr)) (.getMessage tr))) + +(defn print-stack-trace + "Prints a Clojure-oriented stack trace of tr, a Throwable. + Prints a maximum of n stack frames (default: unlimited). + Does not print chained exceptions (causes)." + ([tr] (print-stack-trace tr nil)) + ([tr n] + (let [st (.getStackTrace tr)] + (print-throwable tr) + (newline) + (print " at ") + (print-trace-element (first st)) + (newline) + (doseq [e (if (nil? n) + (rest st) + (take (dec n) (rest st)))] + (print " ") + (print-trace-element e) + (newline))))) + +(defn print-cause-trace + "Like print-stack-trace but prints chained exceptions (causes)." + ([tr] (print-cause-trace tr nil)) + ([tr n] + (print-stack-trace tr n) + (when-let [cause (.getCause tr)] + (print "Caused by: " ) + (recur cause n)))) + +(defn e + "REPL utility. Prints a brief stack trace for the root cause of the + most recent exception." + [] + (print-stack-trace (root-cause *e) 8)) diff --git a/src/clj/clojure/template.clj b/src/clj/clojure/template.clj new file mode 100644 index 00000000..d62390a6 --- /dev/null +++ b/src/clj/clojure/template.clj @@ -0,0 +1,55 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +;;; template.clj - anonymous functions that pre-evaluate sub-expressions + +;; By Stuart Sierra +;; June 23, 2009 + +;; CHANGE LOG +;; +;; June 23, 2009: complete rewrite, eliminated _1,_2,... argument +;; syntax +;; +;; January 20, 2009: added "template?" and checks for valid template +;; expressions. +;; +;; December 15, 2008: first version + + +(ns #^{:author "Stuart Sierra" + :doc "Macros that expand to repeated copies of a template expression."} + clojure.template + (:require [clojure.walk :as walk])) + +(defn apply-template + "For use in macros. argv is an argument list, as in defn. expr is + a quoted expression using the symbols in argv. values is a sequence + of values to be used for the arguments. + + apply-template will recursively replace argument symbols in expr + with their corresponding values, returning a modified expr. + + Example: (apply-template '[x] '(+ x x) '[2]) + ;=> (+ 2 2)" + [argv expr values] + (assert (vector? argv)) + (assert (every? symbol? argv)) + (walk/prewalk-replace (zipmap argv values) expr)) + +(defmacro do-template + "Repeatedly copies expr (in a do block) for each group of arguments + in values. values are automatically partitioned by the number of + arguments in argv, an argument vector as in defn. + + Example: (macroexpand '(do-template [x y] (+ y x) 2 4 3 5)) + ;=> (do (+ 4 2) (+ 5 3))" + [argv expr & values] + (let [c (count argv)] + `(do ~@(map (fn [a] (apply-template argv expr a)) + (partition c values))))) diff --git a/src/clj/clojure/test.clj b/src/clj/clojure/test.clj new file mode 100644 index 00000000..7195034b --- /dev/null +++ b/src/clj/clojure/test.clj @@ -0,0 +1,923 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +;;; test.clj: test framework for Clojure + +;; by Stuart Sierra +;; March 28, 2009 + +;; Thanks to Chas Emerick, Allen Rohner, and Stuart Halloway for +;; contributions and suggestions. + + + +(comment + ;; Inspired by many Common Lisp test frameworks and clojure/test, + ;; this file is a Clojure test framework. + ;; + ;; + ;; + ;; ASSERTIONS + ;; + ;; The core of the library is the "is" macro, which lets you make + ;; assertions of any arbitrary expression: + + (is (= 4 (+ 2 2))) + (is (instance? Integer 256)) + (is (.startsWith "abcde" "ab")) + + ;; You can type an "is" expression directly at the REPL, which will + ;; print a message if it fails. + ;; + ;; user> (is (= 5 (+ 2 2))) + ;; + ;; FAIL in (:1) + ;; expected: (= 5 (+ 2 2)) + ;; actual: (not (= 5 4)) + ;; false + ;; + ;; The "expected:" line shows you the original expression, and the + ;; "actual:" shows you what actually happened. In this case, it + ;; shows that (+ 2 2) returned 4, which is not = to 5. Finally, the + ;; "false" on the last line is the value returned from the + ;; expression. The "is" macro always returns the result of the + ;; inner expression. + ;; + ;; There are two special assertions for testing exceptions. The + ;; "(is (thrown? c ...))" form tests if an exception of class c is + ;; thrown: + + (is (thrown? ArithmeticException (/ 1 0))) + + ;; "(is (thrown-with-msg? c re ...))" does the same thing and also + ;; tests that the message on the exception matches the regular + ;; expression re: + + (is (thrown-with-msg? ArithmeticException #"Divide by zero" + (/ 1 0))) + + ;; + ;; + ;; + ;; DOCUMENTING TESTS + ;; + ;; "is" takes an optional second argument, a string describing the + ;; assertion. This message will be included in the error report. + + (is (= 5 (+ 2 2)) "Crazy arithmetic") + + ;; In addition, you can document groups of assertions with the + ;; "testing" macro, which takes a string followed by any number of + ;; assertions. The string will be included in failure reports. + ;; Calls to "testing" may be nested, and all of the strings will be + ;; joined together with spaces in the final report, in a style + ;; similar to RSpec <http://rspec.info/> + + (testing "Arithmetic" + (testing "with positive integers" + (is (= 4 (+ 2 2))) + (is (= 7 (+ 3 4)))) + (testing "with negative integers" + (is (= -4 (+ -2 -2))) + (is (= -1 (+ 3 -4))))) + + ;; Note that, unlike RSpec, the "testing" macro may only be used + ;; INSIDE a "deftest" or "with-test" form (see below). + ;; + ;; + ;; + ;; DEFINING TESTS + ;; + ;; There are two ways to define tests. The "with-test" macro takes + ;; a defn or def form as its first argument, followed by any number + ;; of assertions. The tests will be stored as metadata on the + ;; definition. + + (with-test + (defn my-function [x y] + (+ x y)) + (is (= 4 (my-function 2 2))) + (is (= 7 (my-function 3 4)))) + + ;; As of Clojure SVN rev. 1221, this does not work with defmacro. + ;; See http://code.google.com/p/clojure/issues/detail?id=51 + ;; + ;; The other way lets you define tests separately from the rest of + ;; your code, even in a different namespace: + + (deftest addition + (is (= 4 (+ 2 2))) + (is (= 7 (+ 3 4)))) + + (deftest subtraction + (is (= 1 (- 4 3))) + (is (= 3 (- 7 4)))) + + ;; This creates functions named "addition" and "subtraction", which + ;; can be called like any other function. Therefore, tests can be + ;; grouped and composed, in a style similar to the test framework in + ;; Peter Seibel's "Practical Common Lisp" + ;; <http://www.gigamonkeys.com/book/practical-building-a-unit-test-framework.html> + + (deftest arithmetic + (addition) + (subtraction)) + + ;; The names of the nested tests will be joined in a list, like + ;; "(arithmetic addition)", in failure reports. You can use nested + ;; tests to set up a context shared by several tests. + ;; + ;; + ;; + ;; RUNNING TESTS + ;; + ;; Run tests with the function "(run-tests namespaces...)": + + (run-tests 'your.namespace 'some.other.namespace) + + ;; If you don't specify any namespaces, the current namespace is + ;; used. To run all tests in all namespaces, use "(run-all-tests)". + ;; + ;; By default, these functions will search for all tests defined in + ;; a namespace and run them in an undefined order. However, if you + ;; are composing tests, as in the "arithmetic" example above, you + ;; probably do not want the "addition" and "subtraction" tests run + ;; separately. In that case, you must define a special function + ;; named "test-ns-hook" that runs your tests in the correct order: + + (defn test-ns-hook [] + (arithmetic)) + + ;; + ;; + ;; + ;; OMITTING TESTS FROM PRODUCTION CODE + ;; + ;; You can bind the variable "*load-tests*" to false when loading or + ;; compiling code in production. This will prevent any tests from + ;; being created by "with-test" or "deftest". + ;; + ;; + ;; + ;; FIXTURES (new) + ;; + ;; Fixtures allow you to run code before and after tests, to set up + ;; the context in which tests should be run. + ;; + ;; A fixture is just a function that calls another function passed as + ;; an argument. It looks like this: + (defn my-fixture [f] + ;; Perform setup, establish bindings, whatever. + (f) ;; Then call the function we were passed. + ;; Tear-down / clean-up code here. + ) + + ;; Fixtures are attached to namespaces in one of two ways. "each" + ;; fixtures are run repeatedly, once for each test function created + ;; with "deftest" or "with-test". "each" fixtures are useful for + ;; establishing a consistent before/after state for each test, like + ;; clearing out database tables. + ;; + ;; "each" fixtures can be attached to the current namespace like this: + (use-fixtures :each fixture1 fixture2 ...) + ;; The fixture1, fixture2 are just functions like the example above. + ;; They can also be anonymous functions, like this: + (use-fixtures :each (fn [f] setup... (f) cleanup...)) + ;; + ;; The other kind of fixture, a "once" fixture, is only run once, + ;; around ALL the tests in the namespace. "once" fixtures are useful + ;; for tasks that only need to be performed once, like establishing + ;; database connections, or for time-consuming tasks. + ;; + ;; Attach "once" fixtures to the current namespace like this: + (use-fixtures :once fixture1 fixture2 ...) + ;; + ;; + ;; + ;; SAVING TEST OUTPUT TO A FILE + ;; + ;; All the test reporting functions write to the var *test-out*. By + ;; default, this is the same as *out*, but you can rebind it to any + ;; PrintWriter. For example, it could be a file opened with + ;; clojure.contrib.duck-streams/writer. + ;; + ;; + ;; + ;; EXTENDING TEST-IS (ADVANCED) + ;; + ;; You can extend the behavior of the "is" macro by defining new + ;; methods for the "assert-expr" multimethod. These methods are + ;; called during expansion of the "is" macro, so they should return + ;; quoted forms to be evaluated. + ;; + ;; You can plug in your own test-reporting framework by rebinding + ;; the "report" function: (report event) + ;; + ;; The 'event' argument is a map. It will always have a :type key, + ;; whose value will be a keyword signaling the type of event being + ;; reported. Standard events with :type value of :pass, :fail, and + ;; :error are called when an assertion passes, fails, and throws an + ;; exception, respectively. In that case, the event will also have + ;; the following keys: + ;; + ;; :expected The form that was expected to be true + ;; :actual A form representing what actually occurred + ;; :message The string message given as an argument to 'is' + ;; + ;; The "testing" strings will be a list in "*testing-contexts*", and + ;; the vars being tested will be a list in "*testing-vars*". + ;; + ;; Your "report" function should wrap any printing calls in the + ;; "with-test-out" macro, which rebinds *out* to the current value + ;; of *test-out*. + ;; + ;; For additional event types, see the examples in the code below. + + ) ;; end comment + + + +(ns + #^{:author "Stuart Sierra, with contributions and suggestions by +Chas Emerick, Allen Rohner, and Stuart Halloway", + :doc "Inspired by many Common Lisp test frameworks and clojure/test, + this file is a Clojure test framework. + + ASSERTIONS + + The core of the library is the \"is\" macro, which lets you make + assertions of any arbitrary expression: + + (is (= 4 (+ 2 2))) + (is (instance? Integer 256)) + (is (.startsWith \"abcde\" \"ab\")) + + You can type an \"is\" expression directly at the REPL, which will + print a message if it fails. + + user> (is (= 5 (+ 2 2))) + + FAIL in (:1) + expected: (= 5 (+ 2 2)) + actual: (not (= 5 4)) + false + + The \"expected:\" line shows you the original expression, and the + \"actual:\" shows you what actually happened. In this case, it + shows that (+ 2 2) returned 4, which is not = to 5. Finally, the + \"false\" on the last line is the value returned from the + expression. The \"is\" macro always returns the result of the + inner expression. + + There are two special assertions for testing exceptions. The + \"(is (thrown? c ...))\" form tests if an exception of class c is + thrown: + + (is (thrown? ArithmeticException (/ 1 0))) + + \"(is (thrown-with-msg? c re ...))\" does the same thing and also + tests that the message on the exception matches the regular + expression re: + + (is (thrown-with-msg? ArithmeticException #\"Divide by zero\" + (/ 1 0))) + + DOCUMENTING TESTS + + \"is\" takes an optional second argument, a string describing the + assertion. This message will be included in the error report. + + (is (= 5 (+ 2 2)) \"Crazy arithmetic\") + + In addition, you can document groups of assertions with the + \"testing\" macro, which takes a string followed by any number of + assertions. The string will be included in failure reports. + Calls to \"testing\" may be nested, and all of the strings will be + joined together with spaces in the final report, in a style + similar to RSpec <http://rspec.info/> + + (testing \"Arithmetic\" + (testing \"with positive integers\" + (is (= 4 (+ 2 2))) + (is (= 7 (+ 3 4)))) + (testing \"with negative integers\" + (is (= -4 (+ -2 -2))) + (is (= -1 (+ 3 -4))))) + + Note that, unlike RSpec, the \"testing\" macro may only be used + INSIDE a \"deftest\" or \"with-test\" form (see below). + + + DEFINING TESTS + + There are two ways to define tests. The \"with-test\" macro takes + a defn or def form as its first argument, followed by any number + of assertions. The tests will be stored as metadata on the + definition. + + (with-test + (defn my-function [x y] + (+ x y)) + (is (= 4 (my-function 2 2))) + (is (= 7 (my-function 3 4)))) + + As of Clojure SVN rev. 1221, this does not work with defmacro. + See http://code.google.com/p/clojure/issues/detail?id=51 + + The other way lets you define tests separately from the rest of + your code, even in a different namespace: + + (deftest addition + (is (= 4 (+ 2 2))) + (is (= 7 (+ 3 4)))) + + (deftest subtraction + (is (= 1 (- 4 3))) + (is (= 3 (- 7 4)))) + + This creates functions named \"addition\" and \"subtraction\", which + can be called like any other function. Therefore, tests can be + grouped and composed, in a style similar to the test framework in + Peter Seibel's \"Practical Common Lisp\" + <http://www.gigamonkeys.com/book/practical-building-a-unit-test-framework.html> + + (deftest arithmetic + (addition) + (subtraction)) + + The names of the nested tests will be joined in a list, like + \"(arithmetic addition)\", in failure reports. You can use nested + tests to set up a context shared by several tests. + + + RUNNING TESTS + + Run tests with the function \"(run-tests namespaces...)\": + + (run-tests 'your.namespace 'some.other.namespace) + + If you don't specify any namespaces, the current namespace is + used. To run all tests in all namespaces, use \"(run-all-tests)\". + + By default, these functions will search for all tests defined in + a namespace and run them in an undefined order. However, if you + are composing tests, as in the \"arithmetic\" example above, you + probably do not want the \"addition\" and \"subtraction\" tests run + separately. In that case, you must define a special function + named \"test-ns-hook\" that runs your tests in the correct order: + + (defn test-ns-hook [] + (arithmetic)) + + + OMITTING TESTS FROM PRODUCTION CODE + + You can bind the variable \"*load-tests*\" to false when loading or + compiling code in production. This will prevent any tests from + being created by \"with-test\" or \"deftest\". + + + FIXTURES (new) + + Fixtures allow you to run code before and after tests, to set up + the context in which tests should be run. + + A fixture is just a function that calls another function passed as + an argument. It looks like this: + + (defn my-fixture [f] + Perform setup, establish bindings, whatever. + (f) Then call the function we were passed. + Tear-down / clean-up code here. + ) + + Fixtures are attached to namespaces in one of two ways. \"each\" + fixtures are run repeatedly, once for each test function created + with \"deftest\" or \"with-test\". \"each\" fixtures are useful for + establishing a consistent before/after state for each test, like + clearing out database tables. + + \"each\" fixtures can be attached to the current namespace like this: + (use-fixtures :each fixture1 fixture2 ...) + The fixture1, fixture2 are just functions like the example above. + They can also be anonymous functions, like this: + (use-fixtures :each (fn [f] setup... (f) cleanup...)) + + The other kind of fixture, a \"once\" fixture, is only run once, + around ALL the tests in the namespace. \"once\" fixtures are useful + for tasks that only need to be performed once, like establishing + database connections, or for time-consuming tasks. + + Attach \"once\" fixtures to the current namespace like this: + (use-fixtures :once fixture1 fixture2 ...) + + + SAVING TEST OUTPUT TO A FILE + + All the test reporting functions write to the var *test-out*. By + default, this is the same as *out*, but you can rebind it to any + PrintWriter. For example, it could be a file opened with + clojure.contrib.duck-streams/writer. + + + EXTENDING TEST-IS (ADVANCED) + + You can extend the behavior of the \"is\" macro by defining new + methods for the \"assert-expr\" multimethod. These methods are + called during expansion of the \"is\" macro, so they should return + quoted forms to be evaluated. + + You can plug in your own test-reporting framework by rebinding + the \"report\" function: (report event) + + The 'event' argument is a map. It will always have a :type key, + whose value will be a keyword signaling the type of event being + reported. Standard events with :type value of :pass, :fail, and + :error are called when an assertion passes, fails, and throws an + exception, respectively. In that case, the event will also have + the following keys: + + :expected The form that was expected to be true + :actual A form representing what actually occurred + :message The string message given as an argument to 'is' + + The \"testing\" strings will be a list in \"*testing-contexts*\", and + the vars being tested will be a list in \"*testing-vars*\". + + Your \"report\" function should wrap any printing calls in the + \"with-test-out\" macro, which rebinds *out* to the current value + of *test-out*. + + For additional event types, see the examples in the code. +"} + clojure.test + (:require [clojure.template :as temp] + [clojure.stacktrace :as stack])) + +;; Nothing is marked "private" here, so you can rebind things to plug +;; in your own testing or reporting frameworks. + + +;;; USER-MODIFIABLE GLOBALS + +(defonce + #^{:doc "True by default. If set to false, no test functions will + be created by deftest, set-test, or with-test. Use this to omit + tests when compiling or loading production code."} + *load-tests* true) + +(def + #^{:doc "The maximum depth of stack traces to print when an Exception + is thrown during a test. Defaults to nil, which means print the + complete stack trace."} + *stack-trace-depth* nil) + + +;;; GLOBALS USED BY THE REPORTING FUNCTIONS + +(def *report-counters* nil) ; bound to a ref of a map in test-ns + +(def *initial-report-counters* ; used to initialize *report-counters* + {:test 0, :pass 0, :fail 0, :error 0}) + +(def *testing-vars* (list)) ; bound to hierarchy of vars being tested + +(def *testing-contexts* (list)) ; bound to hierarchy of "testing" strings + +(def *test-out* *out*) ; PrintWriter for test reporting output + +(defmacro with-test-out + "Runs body with *out* bound to the value of *test-out*." + [& body] + `(binding [*out* *test-out*] + ~@body)) + + + +;;; UTILITIES FOR REPORTING FUNCTIONS + +(defn file-position + "Returns a vector [filename line-number] for the nth call up the + stack." + [n] + (let [s (nth (.getStackTrace (new java.lang.Throwable)) n)] + [(.getFileName s) (.getLineNumber s)])) + +(defn testing-vars-str + "Returns a string representation of the current test. Renders names + in *testing-vars* as a list, then the source file and line of + current assertion." + [] + (let [[file line] (file-position 4)] + (str + ;; Uncomment to include namespace in failure report: + ;;(ns-name (:ns (meta (first *testing-vars*)))) "/ " + (reverse (map #(:name (meta %)) *testing-vars*)) + " (" file ":" line ")"))) + +(defn testing-contexts-str + "Returns a string representation of the current test context. Joins + strings in *testing-contexts* with spaces." + [] + (apply str (interpose " " (reverse *testing-contexts*)))) + +(defn inc-report-counter + "Increments the named counter in *report-counters*, a ref to a map. + Does nothing if *report-counters* is nil." + [name] + (when *report-counters* + (dosync (commute *report-counters* assoc name + (inc (or (*report-counters* name) 0)))))) + + + +;;; TEST RESULT REPORTING + +(defmulti + #^{:doc "Generic reporting function, may be overridden to plug in + different report formats (e.g., TAP, JUnit). Assertions such as + 'is' call 'report' to indicate results. The argument given to + 'report' will be a map with a :type key. See the documentation at + the top of test_is.clj for more information on the types of + arguments for 'report'."} + report :type) + +(defmethod report :default [m] + (with-test-out (prn m))) + +(defmethod report :pass [m] + (with-test-out (inc-report-counter :pass))) + +(defmethod report :fail [m] + (with-test-out + (inc-report-counter :fail) + (println "\nFAIL in" (testing-vars-str)) + (when (seq *testing-contexts*) (println (testing-contexts-str))) + (when-let [message (:message m)] (println message)) + (println "expected:" (pr-str (:expected m))) + (println " actual:" (pr-str (:actual m))))) + +(defmethod report :error [m] + (with-test-out + (inc-report-counter :error) + (println "\nERROR in" (testing-vars-str)) + (when (seq *testing-contexts*) (println (testing-contexts-str))) + (when-let [message (:message m)] (println message)) + (println "expected:" (pr-str (:expected m))) + (print " actual: ") + (let [actual (:actual m)] + (if (instance? Throwable actual) + (stack/print-cause-trace actual *stack-trace-depth*) + (prn actual))))) + +(defmethod report :summary [m] + (with-test-out + (println "\nRan" (:test m) "tests containing" + (+ (:pass m) (:fail m) (:error m)) "assertions.") + (println (:fail m) "failures," (:error m) "errors."))) + +(defmethod report :begin-test-ns [m] + (with-test-out + (println "\nTesting" (ns-name (:ns m))))) + +;; Ignore these message types: +(defmethod report :end-test-ns [m]) +(defmethod report :begin-test-var [m]) +(defmethod report :end-test-var [m]) + + + +;;; UTILITIES FOR ASSERTIONS + +(defn get-possibly-unbound-var + "Like var-get but returns nil if the var is unbound." + [v] + (try (var-get v) + (catch IllegalStateException e + nil))) + +(defn function? + "Returns true if argument is a function or a symbol that resolves to + a function (not a macro)." + [x] + (if (symbol? x) + (when-let [v (resolve x)] + (when-let [value (get-possibly-unbound-var v)] + (and (fn? value) + (not (:macro (meta v)))))) + (fn? x))) + +(defn assert-predicate + "Returns generic assertion code for any functional predicate. The + 'expected' argument to 'report' will contains the original form, the + 'actual' argument will contain the form with all its sub-forms + evaluated. If the predicate returns false, the 'actual' form will + be wrapped in (not...)." + [msg form] + (let [args (rest form) + pred (first form)] + `(let [values# (list ~@args) + result# (apply ~pred values#)] + (if result# + (report {:type :pass, :message ~msg, + :expected '~form, :actual (cons ~pred values#)}) + (report {:type :fail, :message ~msg, + :expected '~form, :actual (list '~'not (cons '~pred values#))})) + result#))) + +(defn assert-any + "Returns generic assertion code for any test, including macros, Java + method calls, or isolated symbols." + [msg form] + `(let [value# ~form] + (if value# + (report {:type :pass, :message ~msg, + :expected '~form, :actual value#}) + (report {:type :fail, :message ~msg, + :expected '~form, :actual value#})) + value#)) + + + +;;; ASSERTION METHODS + +;; You don't call these, but you can add methods to extend the 'is' +;; macro. These define different kinds of tests, based on the first +;; symbol in the test expression. + +(defmulti assert-expr + (fn [msg form] + (cond + (nil? form) :always-fail + (seq? form) (first form) + :else :default))) + +(defmethod assert-expr :always-fail [msg form] + ;; nil test: always fail + `(report {:type :fail, :message ~msg})) + +(defmethod assert-expr :default [msg form] + (if (and (sequential? form) (function? (first form))) + (assert-predicate msg form) + (assert-any msg form))) + +(defmethod assert-expr 'instance? [msg form] + ;; Test if x is an instance of y. + `(let [klass# ~(nth form 1) + object# ~(nth form 2)] + (let [result# (instance? klass# object#)] + (if result# + (report {:type :pass, :message ~msg, + :expected '~form, :actual (class object#)}) + (report {:type :fail, :message ~msg, + :expected '~form, :actual (class object#)})) + result#))) + +(defmethod assert-expr 'thrown? [msg form] + ;; (is (thrown? c expr)) + ;; Asserts that evaluating expr throws an exception of class c. + ;; Returns the exception thrown. + (let [klass (second form) + body (nthnext form 2)] + `(try ~@body + (report {:type :fail, :message ~msg, + :expected '~form, :actual nil}) + (catch ~klass e# + (report {:type :pass, :message ~msg, + :expected '~form, :actual e#}) + e#)))) + +(defmethod assert-expr 'thrown-with-msg? [msg form] + ;; (is (thrown-with-msg? c re expr)) + ;; Asserts that evaluating expr throws an exception of class c. + ;; Also asserts that the message string of the exception matches + ;; (with re-matches) the regular expression re. + (let [klass (nth form 1) + re (nth form 2) + body (nthnext form 3)] + `(try ~@body + (report {:type :fail, :message ~msg, :expected '~form, :actual nil}) + (catch ~klass e# + (let [m# (.getMessage e#)] + (if (re-matches ~re m#) + (report {:type :pass, :message ~msg, + :expected '~form, :actual e#}) + (report {:type :fail, :message ~msg, + :expected '~form, :actual e#}))) + e#)))) + + +(defmacro try-expr + "Used by the 'is' macro to catch unexpected exceptions. + You don't call this." + [msg form] + `(try ~(assert-expr msg form) + (catch Throwable t# + (report {:type :error, :message ~msg, + :expected '~form, :actual t#})))) + + + +;;; ASSERTION MACROS + +;; You use these in your tests. + +(defmacro is + "Generic assertion macro. 'form' is any predicate test. + 'msg' is an optional message to attach to the assertion. + + Example: (is (= 4 (+ 2 2)) \"Two plus two should be 4\") + + Special forms: + + (is (thrown? c body)) checks that an instance of c is thrown from + body, fails if not; then returns the thing thrown. + + (is (thrown-with-msg? c re body)) checks that an instance of c is + thrown AND that the message on the exception matches (with + re-matches) the regular expression re." + ([form] `(is ~form nil)) + ([form msg] `(try-expr ~msg ~form))) + +(defmacro are + "Checks multiple assertions with a template expression. + See clojure.template/do-template for an explanation of + templates. + + Example: (are [x y] (= x y) + 2 (+ 1 1) + 4 (* 2 2)) + Expands to: + (do (is (= 2 (+ 1 1))) + (is (= 4 (* 2 2)))) + + Note: This breaks some reporting features, such as line numbers." + [argv expr & args] + `(temp/do-template ~argv (is ~expr) ~@args)) + +(defmacro testing + "Adds a new string to the list of testing contexts. May be nested, + but must occur inside a test function (deftest)." + [string & body] + `(binding [*testing-contexts* (conj *testing-contexts* ~string)] + ~@body)) + + + +;;; DEFINING TESTS + +(defmacro with-test + "Takes any definition form (that returns a Var) as the first argument. + Remaining body goes in the :test metadata function for that Var. + + When *load-tests* is false, only evaluates the definition, ignoring + the tests." + [definition & body] + (if *load-tests* + `(doto ~definition (alter-meta! assoc :test (fn [] ~@body))) + definition)) + + +(defmacro deftest + "Defines a test function with no arguments. Test functions may call + other tests, so tests may be composed. If you compose tests, you + should also define a function named test-ns-hook; run-tests will + call test-ns-hook instead of testing all vars. + + Note: Actually, the test body goes in the :test metadata on the var, + and the real function (the value of the var) calls test-var on + itself. + + When *load-tests* is false, deftest is ignored." + [name & body] + (when *load-tests* + `(def ~(with-meta name {:test `(fn [] ~@body)}) + (fn [] (test-var (var ~name)))))) + +(defmacro deftest- + "Like deftest but creates a private var." + [name & body] + (when *load-tests* + `(def ~(with-meta name {:test `(fn [] ~@body), :private true}) + (fn [] (test-var (var ~name)))))) + + +(defmacro set-test + "Experimental. + Sets :test metadata of the named var to a fn with the given body. + The var must already exist. Does not modify the value of the var. + + When *load-tests* is false, set-test is ignored." + [name & body] + (when *load-tests* + `(alter-meta! (var ~name) assoc :test (fn [] ~@body)))) + + + +;;; DEFINING FIXTURES + +(defn- add-ns-meta + "Adds elements in coll to the current namespace metadata as the + value of key." + [key coll] + (alter-meta! *ns* assoc key (concat (key (meta *ns*)) coll))) + +(defmulti use-fixtures (fn [fixture-type & args] fixture-type)) + +(defmethod use-fixtures :each [fixture-type & args] + (add-ns-meta ::each-fixtures args)) + +(defmethod use-fixtures :once [fixture-type & args] + (add-ns-meta ::once-fixtures args)) + +(defn- default-fixture + "The default, empty, fixture function. Just calls its argument." + [f] + (f)) + +(defn compose-fixtures + "Composes two fixture functions, creating a new fixture function + that combines their behavior." + [f1 f2] + (fn [g] (f1 (fn [] (f2 g))))) + +(defn join-fixtures + "Composes a collection of fixtures, in order. Always returns a valid + fixture function, even if the collection is empty." + [fixtures] + (reduce compose-fixtures default-fixture fixtures)) + + + + +;;; RUNNING TESTS: LOW-LEVEL FUNCTIONS + +(defn test-var + "If v has a function in its :test metadata, calls that function, + with *testing-vars* bound to (conj *testing-vars* v)." + [v] + (when-let [t (:test (meta v))] + (binding [*testing-vars* (conj *testing-vars* v)] + (report {:type :begin-test-var, :var v}) + (inc-report-counter :test) + (try (t) + (catch Throwable e + (report {:type :error, :message "Uncaught exception, not in assertion." + :expected nil, :actual e}))) + (report {:type :end-test-var, :var v})))) + +(defn test-all-vars + "Calls test-var on every var interned in the namespace, with fixtures." + [ns] + (let [once-fixture-fn (join-fixtures (::once-fixtures (meta ns))) + each-fixture-fn (join-fixtures (::each-fixtures (meta ns)))] + (once-fixture-fn + (fn [] + (doseq [v (vals (ns-interns ns))] + (when (:test (meta v)) + (each-fixture-fn (fn [] (test-var v))))))))) + +(defn test-ns + "If the namespace defines a function named test-ns-hook, calls that. + Otherwise, calls test-all-vars on the namespace. 'ns' is a + namespace object or a symbol. + + Internally binds *report-counters* to a ref initialized to + *inital-report-counters*. Returns the final, dereferenced state of + *report-counters*." + [ns] + (binding [*report-counters* (ref *initial-report-counters*)] + (let [ns-obj (the-ns ns)] + (report {:type :begin-test-ns, :ns ns-obj}) + ;; If the namespace has a test-ns-hook function, call that: + (if-let [v (find-var (symbol (str (ns-name ns-obj)) "test-ns-hook"))] + ((var-get v)) + ;; Otherwise, just test every var in the namespace. + (test-all-vars ns-obj)) + (report {:type :end-test-ns, :ns ns-obj})) + @*report-counters*)) + + + +;;; RUNNING TESTS: HIGH-LEVEL FUNCTIONS + +(defn run-tests + "Runs all tests in the given namespaces; prints results. + Defaults to current namespace if none given." + ([] (run-tests *ns*)) + ([& namespaces] + (report (assoc (apply merge-with + (map test-ns namespaces)) + :type :summary)))) + +(defn run-all-tests + "Runs all tests in all namespaces; prints results. + Optional argument is a regular expression; only namespaces with + names matching the regular expression (with re-matches) will be + tested." + ([] (apply run-tests (all-ns))) + ([re] (apply run-tests (filter #(re-matches re (name (ns-name %))) (all-ns))))) diff --git a/src/clj/clojure/test/tap.clj b/src/clj/clojure/test/tap.clj new file mode 100644 index 00000000..6f4b57a6 --- /dev/null +++ b/src/clj/clojure/test/tap.clj @@ -0,0 +1,111 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +;;; test_is/tap.clj: Extension to test for TAP output + +;; by Stuart Sierra +;; March 31, 2009 + +;; Inspired by ClojureCheck by Meikel Brandmeyer: +;; http://kotka.de/projects/clojure/clojurecheck.html + + +;; DOCUMENTATION +;; +;; This is an extension to clojure.test that adds support +;; for the Test Anything Protocol (TAP). +;; +;; TAP is a simple text-based syntax for reporting test results. TAP +;; was originally develped for Perl, and now has implementations in +;; several languages. For more information on TAP, see +;; http://testanything.org/ and +;; http://search.cpan.org/~petdance/TAP-1.0.0/TAP.pm +;; +;; To use this library, wrap any calls to +;; clojure.test/run-tests in the with-tap-output macro, +;; like this: +;; +;; (use 'clojure.test) +;; (use 'clojure.test.tap) +;; +;; (with-tap-output +;; (run-tests 'my.cool.library)) + + + +(ns clojure.test.tap + (:require [clojure.test :as t] + [clojure.stacktrace :as stack])) + +(defn print-tap-plan + "Prints a TAP plan line like '1..n'. n is the number of tests" + [n] + (println (str "1.." n))) + +(defn print-tap-diagnostic + "Prints a TAP diagnostic line. data is a (possibly multi-line) + string." + [data] + (doseq [line (.split data "\n")] + (println "#" line))) + +(defn print-tap-pass + "Prints a TAP 'ok' line. msg is a string, with no line breaks" + [msg] + (println "ok" msg)) + +(defn print-tap-fail + "Prints a TAP 'not ok' line. msg is a string, with no line breaks" + [msg] + (println "not ok" msg)) + +;; This multimethod will override test/report +(defmulti tap-report (fn [data] (:type data))) + +(defmethod tap-report :default [data] + (t/with-test-out + (print-tap-diagnostic (pr-str data)))) + +(defmethod tap-report :pass [data] + (t/with-test-out + (t/inc-report-counter :pass) + (print-tap-pass (t/testing-vars-str)) + (when (seq t/*testing-contexts*) + (print-tap-diagnostic (t/testing-contexts-str))) + (when (:message data) + (print-tap-diagnostic (:message data))) + (print-tap-diagnostic (str "expected:" (pr-str (:expected data)))) + (print-tap-diagnostic (str " actual:" (pr-str (:actual data)))))) + +(defmethod tap-report :error [data] + (t/with-test-out + (t/inc-report-counter :error) + (print-tap-fail (t/testing-vars-str)) + (when (seq t/*testing-contexts*) + (print-tap-diagnostic (t/testing-contexts-str))) + (when (:message data) + (print-tap-diagnostic (:message data))) + (print-tap-diagnostic "expected:" (pr-str (:expected data))) + (print-tap-diagnostic " actual: ") + (print-tap-diagnostic + (with-out-str + (if (instance? Throwable (:actual data)) + (stack/print-cause-trace (:actual data) t/*stack-trace-depth*) + (prn (:actual data))))))) + +(defmethod tap-report :summary [data] + (t/with-test-out + (print-tap-plan (+ (:pass data) (:fail data) (:error data))))) + + +(defmacro with-tap-output + "Execute body with modified test reporting functions that produce + TAP output" + [& body] + `(binding [t/report tap-report] + ~@body)) diff --git a/src/clj/clojure/walk.clj b/src/clj/clojure/walk.clj new file mode 100644 index 00000000..6b5bad90 --- /dev/null +++ b/src/clj/clojure/walk.clj @@ -0,0 +1,133 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +;;; walk.clj - generic tree walker with replacement + +;; by Stuart Sierra +;; December 15, 2008 + +;; This file defines a generic tree walker for Clojure data +;; structures. It takes any data structure (list, vector, map, set, +;; seq), calls a function on every element, and uses the return value +;; of the function in place of the original. This makes it fairly +;; easy to write recursive search-and-replace functions, as shown in +;; the examples. +;; +;; Note: "walk" supports all Clojure data structures EXCEPT maps +;; created with sorted-map-by. There is no (obvious) way to retrieve +;; the sorting function. +;; +;; CHANGE LOG: +;; +;; * December 15, 2008: replaced 'walk' with 'prewalk' & 'postwalk' +;; +;; * December 9, 2008: first version + + +(ns + #^{:author "Stuart Sierra", + :doc "This file defines a generic tree walker for Clojure data +structures. It takes any data structure (list, vector, map, set, +seq), calls a function on every element, and uses the return value +of the function in place of the original. This makes it fairly +easy to write recursive search-and-replace functions, as shown in +the examples. + +Note: \"walk\" supports all Clojure data structures EXCEPT maps +created with sorted-map-by. There is no (obvious) way to retrieve +the sorting function."} + clojure.walk) + +(defn walk + "Traverses form, an arbitrary data structure. inner and outer are + functions. Applies inner to each element of form, building up a + data structure of the same type, then applies outer to the result. + Recognizes all Clojure data structures except sorted-map-by. + Consumes seqs as with doall." + [inner outer form] + (cond + (list? form) (outer (apply list (map inner form))) + (seq? form) (outer (doall (map inner form))) + (vector? form) (outer (vec (map inner form))) + (map? form) (outer (into (if (sorted? form) (sorted-map) {}) + (map inner form))) + (set? form) (outer (into (if (sorted? form) (sorted-set) #{}) + (map inner form))) + :else (outer form))) + +(defn postwalk + "Performs a depth-first, post-order traversal of form. Calls f on + each sub-form, uses f's return value in place of the original. + Recognizes all Clojure data structures except sorted-map-by. + Consumes seqs as with doall." + [f form] + (walk (partial postwalk f) f form)) + +(defn prewalk + "Like postwalk, but does pre-order traversal." + [f form] + (walk (partial prewalk f) identity (f form))) + + +;; Note: I wanted to write: +;; +;; (defn walk +;; [f form] +;; (let [pf (partial walk f)] +;; (if (coll? form) +;; (f (into (empty form) (map pf form))) +;; (f form)))) +;; +;; but this throws a ClassCastException when applied to a map. + + +(defn postwalk-demo + "Demonstrates the behavior of postwalk by printing each form as it is + walked. Returns form." + [form] + (postwalk (fn [x] (print "Walked: ") (prn x) x) form)) + +(defn prewalk-demo + "Demonstrates the behavior of prewalk by printing each form as it is + walked. Returns form." + [form] + (prewalk (fn [x] (print "Walked: ") (prn x) x) form)) + +(defn keywordize-keys + "Recursively transforms all map keys from strings to keywords." + [m] + (let [f (fn [[k v]] (if (string? k) [(keyword k) v] [k v]))] + ;; only apply to maps + (postwalk (fn [x] (if (map? x) (into {} (map f x)) x)) m))) + +(defn stringify-keys + "Recursively transforms all map keys from keywords to strings." + [m] + (let [f (fn [[k v]] (if (keyword? k) [(name k) v] [k v]))] + ;; only apply to maps + (postwalk (fn [x] (if (map? x) (into {} (map f x)) x)) m))) + +(defn prewalk-replace + "Recursively transforms form by replacing keys in smap with their + values. Like clojure/replace but works on any data structure. Does + replacement at the root of the tree first." + [smap form] + (prewalk (fn [x] (if (contains? smap x) (smap x) x)) form)) + +(defn postwalk-replace + "Recursively transforms form by replacing keys in smap with their + values. Like clojure/replace but works on any data structure. Does + replacement at the leaves of the tree first." + [smap form] + (postwalk (fn [x] (if (contains? smap x) (smap x) x)) form)) + +(defn macroexpand-all + "Recursively performs all possible macroexpansions in form." + [form] + (prewalk (fn [x] (if (seq? x) (macroexpand x) x)) form)) + diff --git a/src/jvm/clojure/lang/Compiler.java b/src/jvm/clojure/lang/Compiler.java index cb14d96f..9d744d70 100644 --- a/src/jvm/clojure/lang/Compiler.java +++ b/src/jvm/clojure/lang/Compiler.java @@ -971,7 +971,7 @@ static class InstanceFieldExpr extends FieldExpr implements AssignableExpr{ public void emitAssign(C context, FnExpr fn, GeneratorAdapter gen, Expr val){ gen.visitLineNumber(line, gen.mark()); - if(targetClass != null) + if(targetClass != null && field != null) { target.emit(C.EXPRESSION, fn, gen); gen.checkCast(Type.getType(targetClass)); diff --git a/src/jvm/clojure/lang/LispReader.java b/src/jvm/clojure/lang/LispReader.java index 14c39399..5bf22e66 100644 --- a/src/jvm/clojure/lang/LispReader.java +++ b/src/jvm/clojure/lang/LispReader.java @@ -47,9 +47,9 @@ static Pattern symbolPat = Pattern.compile("[:]?([\\D&&[^/]].*/)?([\\D&&[^/]][^/ //static Pattern intPat = Pattern.compile("[-+]?[0-9]+\\.?"); static Pattern intPat = Pattern.compile( - "([-+]?)(?:(0)|([1-9][0-9]*)|0[xX]([0-9A-Fa-f]+)|0([0-7]+)|([1-9][0-9]?)[rR]([0-9A-Za-z]+)|0[0-9]+)\\.?"); + "([-+]?)(?:(0)|([1-9][0-9]*)|0[xX]([0-9A-Fa-f]+)|0([0-7]+)|([1-9][0-9]?)[rR]([0-9A-Za-z]+)|0[0-9]+)"); static Pattern ratioPat = Pattern.compile("([-+]?[0-9]+)/([0-9]+)"); -static Pattern floatPat = Pattern.compile("[-+]?[0-9]+(\\.[0-9]+)?([eE][-+]?[0-9]+)?[M]?"); +static Pattern floatPat = Pattern.compile("([-+]?[0-9]+(\\.[0-9]*)?([eE][-+]?[0-9]+)?)(M)?"); static final Symbol SLASH = Symbol.create("/"); static final Symbol CLOJURE_SLASH = Symbol.create("clojure.core","/"); //static Pattern accessorPat = Pattern.compile("\\.[a-zA-Z_]\\w*"); @@ -344,8 +344,8 @@ private static Object matchNumber(String s){ m = floatPat.matcher(s); if(m.matches()) { - if(s.charAt(s.length() - 1) == 'M') - return new BigDecimal(s.substring(0, s.length() - 1)); + if(m.group(4) != null) + return new BigDecimal(m.group(1)); return Double.parseDouble(s); } m = ratioPat.matcher(s); @@ -607,6 +607,10 @@ static Symbol registerArg(int n){ static class ArgReader extends AFn{ public Object invoke(Object reader, Object pct) throws Exception{ PushbackReader r = (PushbackReader) reader; + if(ARG_ENV.deref() == null) + { + return interpretToken(readToken(r, '%')); + } int ch = r.read(); unread(r, ch); //% alone is first arg diff --git a/src/jvm/clojure/lang/LockingTransaction.java b/src/jvm/clojure/lang/LockingTransaction.java index 66a262e7..4976d169 100644 --- a/src/jvm/clojure/lang/LockingTransaction.java +++ b/src/jvm/clojure/lang/LockingTransaction.java @@ -281,11 +281,14 @@ Object run(Callable fn) throws Exception{ Ref ref = e.getKey(); Object oldval = ref.tvals == null ? null : ref.tvals.val; Object newval = e.getValue(); + int hcount = ref.histCount(); + if(ref.tvals == null) { ref.tvals = new Ref.TVal(newval, commitPoint, msecs); } - else if(ref.faults.get() > 0) + else if((ref.faults.get() > 0 && hcount < ref.maxHistory) + || hcount < ref.minHistory) { ref.tvals = new Ref.TVal(newval, commitPoint, msecs, ref.tvals); ref.faults.set(0); diff --git a/src/jvm/clojure/lang/RT.java b/src/jvm/clojure/lang/RT.java index 728a2a76..263ec551 100644 --- a/src/jvm/clojure/lang/RT.java +++ b/src/jvm/clojure/lang/RT.java @@ -179,6 +179,7 @@ final static public Var ERR = final static Keyword TAG_KEY = Keyword.intern(null, "tag"); final static public Var AGENT = Var.intern(CLOJURE_NS, Symbol.create("*agent*"), null); final static public Var READEVAL = Var.intern(CLOJURE_NS, Symbol.create("*read-eval*"), T); +final static public Var ASSERT = Var.intern(CLOJURE_NS, Symbol.create("*assert*"), T); final static public Var MACRO_META = Var.intern(CLOJURE_NS, Symbol.create("*macro-meta*"), null); final static public Var MATH_CONTEXT = Var.intern(CLOJURE_NS, Symbol.create("*math-context*"), null); static Keyword LINE_KEY = Keyword.intern(null, "line"); @@ -720,12 +721,6 @@ static public Object dissoc(Object coll, Object key) throws Exception{ static public Object nth(Object coll, int n){ if(coll instanceof Indexed) return ((Indexed) coll).nth(n); - return do_nth(coll,n); -} - -static public Object do_nth(Object coll, int n){ - if(coll instanceof Indexed) - return ((Indexed) coll).nth(n); if(coll == null) return null; else if(coll instanceof String) diff --git a/src/jvm/clojure/lang/Ref.java b/src/jvm/clojure/lang/Ref.java index 90faedcc..fef7c439 100644 --- a/src/jvm/clojure/lang/Ref.java +++ b/src/jvm/clojure/lang/Ref.java @@ -26,6 +26,24 @@ public class Ref extends ARef implements IFn, Comparable<Ref>, IRef{ return 1; } +public int getMinHistory(){ + return minHistory; +} + +public Ref setMinHistory(int minHistory){ + this.minHistory = minHistory; + return this; +} + +public int getMaxHistory(){ + return maxHistory; +} + +public Ref setMaxHistory(int maxHistory){ + this.maxHistory = maxHistory; + return this; +} + public static class TVal{ Object val; long point; @@ -60,6 +78,9 @@ LockingTransaction.Info tinfo; //IFn validator; final long id; +volatile int minHistory = 0; +volatile int maxHistory = 10; + static final AtomicLong ids = new AtomicLong(); public Ref(Object initVal) throws Exception{ @@ -187,6 +208,29 @@ public void trimHistory(){ } } +public int getHistoryCount(){ + try + { + lock.writeLock().lock(); + return histCount(); + } + finally + { + lock.writeLock().unlock(); + } +} + +int histCount(){ + if(tvals == null) + return 0; + else + { + int count = 0; + for(TVal tv = tvals.next;tv != tvals;tv = tv.next) + count++; + return count; + } +} final public IFn fn(){ return (IFn) deref(); diff --git a/test/clojure/test_clojure.clj b/test/clojure/test_clojure.clj new file mode 100644 index 00000000..8b1e16ae --- /dev/null +++ b/test/clojure/test_clojure.clj @@ -0,0 +1,68 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. +; + +;; clojure.test-clojure +;; +;; Tests for the facilities provided by Clojure +;; +;; scgilardi (gmail) +;; Created 22 October 2008 + +(ns clojure.test-clojure + (:use [clojure.test :only (run-tests)]) + (:gen-class)) + +(def test-names + [:reader + :printer + :compilation + :evaluation + :special + :macros + :metadata + :ns-libs + :logic + :predicates + :control + :data-structures + :numbers + :sequences + :for + :multimethods + :other-functions + :vars + :refs + :agents + :atoms + :parallel + :java-interop + :test + :test-fixtures + ;; libraries + :clojure-set + :clojure-xml + :clojure-zip + ]) + +(def test-namespaces + (map #(symbol (str "clojure.test-clojure." (name %))) + test-names)) + +(defn run + "Runs all defined tests" + [] + (println "Loading tests...") + (apply require :reload-all test-namespaces) + (apply run-tests test-namespaces)) + +(defn -main + "Run all defined tests from the command line" + [& args] + (run) + (System/exit 0)) diff --git a/test/clojure/test_clojure/agents.clj b/test/clojure/test_clojure/agents.clj new file mode 100644 index 00000000..63b6c8cc --- /dev/null +++ b/test/clojure/test_clojure/agents.clj @@ -0,0 +1,43 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +;; Author: Shawn Hoover + +(ns clojure.test-clojure.agents + (:use clojure.test)) + +(deftest handle-all-throwables-during-agent-actions + ;; Bug fixed in r1198; previously hung Clojure or didn't report agent errors + ;; after OutOfMemoryError, yet wouldn't execute new actions. + (let [agt (agent nil)] + (send agt (fn [state] (throw (Throwable. "just testing Throwables")))) + (try + ;; Let the action finish; eat the "agent has errors" error that bubbles up + (await agt) + (catch RuntimeException _)) + (is (instance? Throwable (first (agent-errors agt)))) + (is (= 1 (count (agent-errors agt)))) + + ;; And now send an action that should work + (clear-agent-errors agt) + (is (= nil @agt)) + (send agt nil?) + (await agt) + (is (true? @agt)))) + + +; http://clojure.org/agents + +; agent +; deref, @-reader-macro, agent-errors +; send send-off clear-agent-errors +; await await-for +; set-validator get-validator +; add-watch remove-watch +; shutdown-agents + diff --git a/test/clojure/test_clojure/atoms.clj b/test/clojure/test_clojure/atoms.clj new file mode 100644 index 00000000..672a1487 --- /dev/null +++ b/test/clojure/test_clojure/atoms.clj @@ -0,0 +1,20 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +;;Author: Frantisek Sodomka + +(ns clojure.test-clojure.atoms + (:use clojure.test)) + +; http://clojure.org/atoms + +; atom +; deref, @-reader-macro +; swap! reset! +; compare-and-set! + diff --git a/test/clojure/test_clojure/clojure_set.clj b/test/clojure/test_clojure/clojure_set.clj new file mode 100644 index 00000000..3339134d --- /dev/null +++ b/test/clojure/test_clojure/clojure_set.clj @@ -0,0 +1,120 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +;; Author: Frantisek Sodomka + + +(ns clojure.test-clojure.clojure-set + (:use clojure.test) + (:require [clojure.set :as set])) + + +(deftest test-union + (are [x y] (= x y) + (set/union) #{} + + ; identity + (set/union #{}) #{} + (set/union #{1}) #{1} + (set/union #{1 2 3}) #{1 2 3} + + ; 2 sets, at least one is empty + (set/union #{} #{}) #{} + (set/union #{} #{1}) #{1} + (set/union #{} #{1 2 3}) #{1 2 3} + (set/union #{1} #{}) #{1} + (set/union #{1 2 3} #{}) #{1 2 3} + + ; 2 sets + (set/union #{1} #{2}) #{1 2} + (set/union #{1} #{1 2}) #{1 2} + (set/union #{2} #{1 2}) #{1 2} + (set/union #{1 2} #{3}) #{1 2 3} + (set/union #{1 2} #{2 3}) #{1 2 3} + + ; 3 sets, some are empty + (set/union #{} #{} #{}) #{} + (set/union #{1} #{} #{}) #{1} + (set/union #{} #{1} #{}) #{1} + (set/union #{} #{} #{1}) #{1} + (set/union #{1 2} #{2 3} #{}) #{1 2 3} + + ; 3 sets + (set/union #{1 2} #{3 4} #{5 6}) #{1 2 3 4 5 6} + (set/union #{1 2} #{2 3} #{1 3 4}) #{1 2 3 4} + + ; different data types + (set/union #{1 2} #{:a :b} #{nil} #{false true} #{\c "abc"} #{[] [1 2]} + #{{} {:a 1}} #{#{} #{1 2}}) + #{1 2 :a :b nil false true \c "abc" [] [1 2] {} {:a 1} #{} #{1 2}} + + ; different types of sets + (set/union (hash-set) (hash-set 1 2) (hash-set 2 3)) + (hash-set 1 2 3) + (set/union (sorted-set) (sorted-set 1 2) (sorted-set 2 3)) + (sorted-set 1 2 3) + (set/union (hash-set) (hash-set 1 2) (hash-set 2 3) + (sorted-set) (sorted-set 4 5) (sorted-set 5 6)) + (hash-set 1 2 3 4 5 6) ; also equals (sorted-set 1 2 3 4 5 6) +)) + + +(deftest test-intersection + ; at least one argument is needed + (is (thrown? IllegalArgumentException (set/intersection))) + + (are [x y] (= x y) + ; identity + (set/intersection #{}) #{} + (set/intersection #{1}) #{1} + (set/intersection #{1 2 3}) #{1 2 3} + + ; 2 sets, at least one is empty + (set/intersection #{} #{}) #{} + (set/intersection #{} #{1}) #{} + (set/intersection #{} #{1 2 3}) #{} + (set/intersection #{1} #{}) #{} + (set/intersection #{1 2 3} #{}) #{} + + ; 2 sets + (set/intersection #{1 2} #{1 2}) #{1 2} + (set/intersection #{1 2} #{3 4}) #{} + (set/intersection #{1 2} #{1}) #{1} + (set/intersection #{1 2} #{2}) #{2} + (set/intersection #{1 2 4} #{2 3 4 5}) #{2 4} + + ; 3 sets, some are empty + (set/intersection #{} #{} #{}) #{} + (set/intersection #{1} #{} #{}) #{} + (set/intersection #{1} #{1} #{}) #{} + (set/intersection #{1} #{} #{1}) #{} + (set/intersection #{1 2} #{2 3} #{}) #{} + + ; 3 sets + (set/intersection #{1 2} #{2 3} #{5 2}) #{2} + (set/intersection #{1 2 3} #{1 3 4} #{1 3}) #{1 3} + (set/intersection #{1 2 3} #{3 4 5} #{8 2 3}) #{3} + + ; different types of sets + (set/intersection (hash-set 1 2) (hash-set 2 3)) #{2} + (set/intersection (sorted-set 1 2) (sorted-set 2 3)) #{2} + (set/intersection + (hash-set 1 2) (hash-set 2 3) + (sorted-set 1 2) (sorted-set 2 3)) #{2} )) + + +; difference +; +; select +; project +; rename-keys +; rename +; index +; map-invert +; join + diff --git a/test/clojure/test_clojure/clojure_xml.clj b/test/clojure/test_clojure/clojure_xml.clj new file mode 100644 index 00000000..cf7eb950 --- /dev/null +++ b/test/clojure/test_clojure/clojure_xml.clj @@ -0,0 +1,21 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +;;Author: Frantisek Sodomka + + +(ns clojure.test-clojure.clojure-xml + (:use clojure.test) + (:require [clojure.xml :as xml])) + + +; parse + +; emit-element +; emit + diff --git a/test/clojure/test_clojure/clojure_zip.clj b/test/clojure/test_clojure/clojure_zip.clj new file mode 100644 index 00000000..f4190ece --- /dev/null +++ b/test/clojure/test_clojure/clojure_zip.clj @@ -0,0 +1,48 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +; Author: Frantisek Sodomka + + +(ns clojure.test-clojure.clojure-zip + (:use clojure.test) + (:require [clojure.zip :as zip])) + + +; zipper +; +; seq-zip +; vector-zip +; xml-zip +; +; node +; branch? +; children +; make-node +; path +; lefts +; rights +; down +; up +; root +; right +; rightmost +; left +; leftmost +; +; insert-left +; insert-right +; replace +; edit +; insert-child +; append-child +; next +; prev +; end? +; remove + diff --git a/test/clojure/test_clojure/compilation.clj b/test/clojure/test_clojure/compilation.clj new file mode 100644 index 00000000..c633db6d --- /dev/null +++ b/test/clojure/test_clojure/compilation.clj @@ -0,0 +1,39 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +; Author: Frantisek Sodomka + + +(ns clojure.test-clojure.compilation + (:use clojure.test)) + +; http://clojure.org/compilation + +; compile +; gen-class, gen-interface + + +(deftest test-compiler-metadata + (let [m ^#'when] + (are [x y] (= x y) + (list? (:arglists m)) true + (> (count (:arglists m)) 0) true + + (string? (:doc m)) true + (> (.length (:doc m)) 0) true + + (string? (:file m)) true + (> (.length (:file m)) 0) true + + (integer? (:line m)) true + (> (:line m) 0) true + + (:macro m) true + (:name m) 'when ))) + + diff --git a/test/clojure/test_clojure/control.clj b/test/clojure/test_clojure/control.clj new file mode 100644 index 00000000..3a223d58 --- /dev/null +++ b/test/clojure/test_clojure/control.clj @@ -0,0 +1,117 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +; Author: Frantisek Sodomka + +;; +;; Test "flow control" constructs. +;; + +(ns clojure.test-clojure.control + (:use clojure.test + [clojure.test-clojure.test-utils :only (exception)])) + +;; *** Helper functions *** + +(defn maintains-identity [f] + (are [x] (= (f x) x) + nil + false true + 0 42 + 0.0 3.14 + 2/3 + 0M 1M + \c + "" "abc" + 'sym + :kw + () '(1 2) + [] [1 2] + {} {:a 1 :b 2} + #{} #{1 2} )) + + +; http://clojure.org/special_forms +; http://clojure.org/macros + +(deftest test-do + (are [x y] (= x y) + ; no params => nil + (do) nil + + ; return last + (do 1) 1 + (do 1 2) 2 + (do 1 2 3 4 5) 5 + + ; evaluate and return last + (let [a (atom 0)] + (do (reset! a (+ @a 1)) ; 1 + (reset! a (+ @a 1)) ; 2 + (reset! a (+ @a 1)) ; 3 + @a)) 3 ) + + ; identity (= (do x) x) + (maintains-identity (fn [_] (do _))) ) + + +; loop/recur +; throw, try + +; [if (logic.clj)], if-not, if-let +; when, when-not, when-let, when-first + + +(deftest test-cond + (are [x y] (= x y) + (cond) nil + + (cond nil true) nil + (cond false true) nil + + (cond true 1 true (exception)) 1 + (cond nil 1 false 2 true 3 true 4) 3 + (cond nil 1 false 2 true 3 true (exception)) 3 ) + + ; false + (are [x] (= (cond x :a true :b) :b) + nil false ) + + ; true + (are [x] (= (cond x :a true :b) :a) + true + 0 42 + 0.0 3.14 + 2/3 + 0M 1M + \c + "" "abc" + 'sym + :kw + () '(1 2) + [] [1 2] + {} {:a 1 :b 2} + #{} #{1 2} ) + + ; evaluation + (are [x y] (= x y) + (cond (> 3 2) (+ 1 2) true :result true (exception)) 3 + (cond (< 3 2) (+ 1 2) true :result true (exception)) :result ) + + ; identity (= (cond true x) x) + (maintains-identity (fn [_] (cond true _))) ) + + +; condp + +; [for, doseq (for.clj)] + +; dotimes, while + +; locking, monitor-enter, monitor-exit + diff --git a/test/clojure/test_clojure/data_structures.clj b/test/clojure/test_clojure/data_structures.clj new file mode 100644 index 00000000..19fafe62 --- /dev/null +++ b/test/clojure/test_clojure/data_structures.clj @@ -0,0 +1,736 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +; Author: Frantisek Sodomka + + +(ns clojure.test-clojure.data-structures + (:use clojure.test)) + + +;; *** Helper functions *** + +(defn diff [s1 s2] + (seq (reduce disj (set s1) (set s2)))) + + +;; *** General *** + +(defstruct equality-struct :a :b) + +(deftest test-equality + ; nil is not equal to any other value + (are [x] (not (= nil x)) + true false + 0 0.0 + \space + "" #"" + () [] #{} {} + (lazy-seq nil) ; SVN 1292: fixed (= (lazy-seq nil) nil) + (lazy-seq ()) + (lazy-seq []) + (lazy-seq {}) + (lazy-seq #{}) + (lazy-seq "") + (lazy-seq (into-array [])) + (new Object) ) + + ; numbers equality across types (see tests below - NOT IMPLEMENTED YET) + + ; ratios + (is (= 1/2 0.5)) + (is (= 1/1000 0.001)) + (is (not= 2/3 0.6666666666666666)) + + ; vectors equal other seqs by items equality + (are [x y] (= x y) + '() [] ; regression fixed in r1208; was not equal + '(1) [1] + '(1 2) [1 2] + + [] '() ; same again, but vectors first + [1] '(1) + [1 2] '(1 2) ) + (is (not= [1 2] '(2 1))) ; order of items matters + + ; list and vector vs. set and map + (are [x y] (not= x y) + ; only () equals [] + () #{} + () {} + [] #{} + [] {} + #{} {} + ; only '(1) equals [1] + '(1) #{1} + [1] #{1} ) + + ; sorted-map, hash-map and array-map - classes differ, but content is equal + +;; TODO: reimplement all-are with new do-template? +;; (all-are (not= (class _1) (class _2)) +;; (sorted-map :a 1) +;; (hash-map :a 1) +;; (array-map :a 1)) +;; (all-are (= _1 _2) +;; (sorted-map) +;; (hash-map) +;; (array-map)) +;; (all-are (= _1 _2) +;; (sorted-map :a 1) +;; (hash-map :a 1) +;; (array-map :a 1)) +;; (all-are (= _1 _2) +;; (sorted-map :a 1 :z 3 :c 2) +;; (hash-map :a 1 :z 3 :c 2) +;; (array-map :a 1 :z 3 :c 2)) + + ; struct-map vs. sorted-map, hash-map and array-map + (are [x] (and (not= (class (struct equality-struct 1 2)) (class x)) + (= (struct equality-struct 1 2) x)) + (sorted-map :a 1 :b 2) + (hash-map :a 1 :b 2) + (array-map :a 1 :b 2)) + + ; sorted-set vs. hash-set + (is (not= (class (sorted-set 1)) (class (hash-set 1)))) + (are [x y] (= x y) + (sorted-set) (hash-set) + (sorted-set 1) (hash-set 1) + (sorted-set 3 2 1) (hash-set 3 2 1) )) + + +;; *** Collections *** + +(deftest test-count + (are [x y] (= x y) + (count nil) 0 + + (count ()) 0 + (count '(1)) 1 + (count '(1 2 3)) 3 + + (count []) 0 + (count [1]) 1 + (count [1 2 3]) 3 + + (count #{}) 0 + (count #{1}) 1 + (count #{1 2 3}) 3 + + (count {}) 0 + (count {:a 1}) 1 + (count {:a 1 :b 2 :c 3}) 3 + + (count "") 0 + (count "a") 1 + (count "abc") 3 + + (count (into-array [])) 0 + (count (into-array [1])) 1 + (count (into-array [1 2 3])) 3 + + (count (java.util.ArrayList. [])) 0 + (count (java.util.ArrayList. [1])) 1 + (count (java.util.ArrayList. [1 2 3])) 3 + + (count (java.util.HashMap. {})) 0 + (count (java.util.HashMap. {:a 1})) 1 + (count (java.util.HashMap. {:a 1 :b 2 :c 3})) 3 ) + + ; different types + (are [x] (= (count [x]) 1) + nil true false + 0 0.0 "" \space + () [] #{} {} )) + + +(deftest test-conj + ; doesn't work on strings or arrays + (is (thrown? ClassCastException (conj "" \a))) + (is (thrown? ClassCastException (conj (into-array []) 1))) + + (are [x y] (= x y) + (conj nil 1) '(1) + (conj nil 3 2 1) '(1 2 3) + + (conj nil nil) '(nil) + (conj nil nil nil) '(nil nil) + (conj nil nil nil 1) '(1 nil nil) + + ; list -> conj puts the item at the front of the list + (conj () 1) '(1) + (conj () 1 2) '(2 1) + + (conj '(2 3) 1) '(1 2 3) + (conj '(2 3) 1 4 3) '(3 4 1 2 3) + + (conj () nil) '(nil) + (conj () ()) '(()) + + ; vector -> conj puts the item at the end of the vector + (conj [] 1) [1] + (conj [] 1 2) [1 2] + + (conj [2 3] 1) [2 3 1] + (conj [2 3] 1 4 3) [2 3 1 4 3] + + (conj [] nil) [nil] + (conj [] []) [[]] + + ; map -> conj expects another (possibly single entry) map as the item, + ; and returns a new map which is the old map plus the entries + ; from the new, which may overwrite entries of the old. + ; conj also accepts a MapEntry or a vector of two items (key and value). + (conj {} {}) {} + (conj {} {:a 1}) {:a 1} + (conj {} {:a 1 :b 2}) {:a 1 :b 2} + (conj {} {:a 1 :b 2} {:c 3}) {:a 1 :b 2 :c 3} + (conj {} {:a 1 :b 2} {:a 3 :c 4}) {:a 3 :b 2 :c 4} + + (conj {:a 1} {:a 7}) {:a 7} + (conj {:a 1} {:b 2}) {:a 1 :b 2} + (conj {:a 1} {:a 7 :b 2}) {:a 7 :b 2} + (conj {:a 1} {:a 7 :b 2} {:c 3}) {:a 7 :b 2 :c 3} + (conj {:a 1} {:a 7 :b 2} {:b 4 :c 5}) {:a 7 :b 4 :c 5} + + (conj {} (first {:a 1})) {:a 1} ; MapEntry + (conj {:a 1} (first {:b 2})) {:a 1 :b 2} + (conj {:a 1} (first {:a 7})) {:a 7} + (conj {:a 1} (first {:b 2}) (first {:a 5})) {:a 5 :b 2} + + (conj {} [:a 1]) {:a 1} ; vector + (conj {:a 1} [:b 2]) {:a 1 :b 2} + (conj {:a 1} [:a 7]) {:a 7} + (conj {:a 1} [:b 2] [:a 5]) {:a 5 :b 2} + + (conj {} {nil {}}) {nil {}} + (conj {} {{} nil}) {{} nil} + (conj {} {{} {}}) {{} {}} + + ; set + (conj #{} 1) #{1} + (conj #{} 1 2 3) #{1 2 3} + + (conj #{2 3} 1) #{3 1 2} + (conj #{3 2} 1) #{1 2 3} + + (conj #{2 3} 2) #{2 3} + (conj #{2 3} 2 3) #{2 3} + (conj #{2 3} 4 1 2 3) #{1 2 3 4} + + (conj #{} nil) #{nil} + (conj #{} #{}) #{#{}} )) + + +;; *** Lists and Vectors *** + +(deftest test-peek + ; doesn't work for sets and maps + (is (thrown? ClassCastException (peek #{1}))) + (is (thrown? ClassCastException (peek {:a 1}))) + + (are [x y] (= x y) + (peek nil) nil + + ; list = first + (peek ()) nil + (peek '(1)) 1 + (peek '(1 2 3)) 1 + + (peek '(nil)) nil ; special cases + (peek '(1 nil)) 1 + (peek '(nil 2)) nil + (peek '(())) () + (peek '(() nil)) () + (peek '(() 2 nil)) () + + ; vector = last + (peek []) nil + (peek [1]) 1 + (peek [1 2 3]) 3 + + (peek [nil]) nil ; special cases + (peek [1 nil]) nil + (peek [nil 2]) 2 + (peek [[]]) [] + (peek [[] nil]) nil + (peek [[] 2 nil]) nil )) + + +(deftest test-pop + ; doesn't work for sets and maps + (is (thrown? ClassCastException (pop #{1}))) + (is (thrown? ClassCastException (pop #{:a 1}))) + + ; collection cannot be empty + (is (thrown? IllegalStateException (pop ()))) + (is (thrown? IllegalStateException (pop []))) + + (are [x y] (= x y) + (pop nil) nil + + ; list - pop first + (pop '(1)) () + (pop '(1 2 3)) '(2 3) + + (pop '(nil)) () + (pop '(1 nil)) '(nil) + (pop '(nil 2)) '(2) + (pop '(())) () + (pop '(() nil)) '(nil) + (pop '(() 2 nil)) '(2 nil) + + ; vector - pop last + (pop [1]) [] + (pop [1 2 3]) [1 2] + + (pop [nil]) [] + (pop [1 nil]) [1] + (pop [nil 2]) [nil] + (pop [[]]) [] + (pop [[] nil]) [[]] + (pop [[] 2 nil]) [[] 2] )) + + +;; *** Lists (IPersistentList) *** + +(deftest test-list + (are [x] (list? x) + () + '() + (list) + (list 1 2 3) ) + + ; order is important + (are [x y] (not (= x y)) + (list 1 2) (list 2 1) + (list 3 1 2) (list 1 2 3) ) + + (are [x y] (= x y) + '() () + (list) '() + (list 1) '(1) + (list 1 2) '(1 2) + + ; nesting + (list 1 (list 2 3) (list 3 (list 4 5 (list 6 (list 7))))) + '(1 (2 3) (3 (4 5 (6 (7))))) + + ; different data structures + (list true false nil) + '(true false nil) + (list 1 2.5 2/3 "ab" \x 'cd :kw) + '(1 2.5 2/3 "ab" \x cd :kw) + (list (list 1 2) [3 4] {:a 1 :b 2} #{:c :d}) + '((1 2) [3 4] {:a 1 :b 2} #{:c :d}) + + ; evaluation + (list (+ 1 2) [(+ 2 3) 'a] (list (* 2 3) 8)) + '(3 [5 a] (6 8)) + + ; special cases + (list nil) '(nil) + (list 1 nil) '(1 nil) + (list nil 2) '(nil 2) + (list ()) '(()) + (list 1 ()) '(1 ()) + (list () 2) '(() 2) )) + + +;; *** Maps (IPersistentMap) *** + +(deftest test-find + (are [x y] (= x y) + (find {} :a) nil + + (find {:a 1} :a) [:a 1] + (find {:a 1} :b) nil + + (find {:a 1 :b 2} :a) [:a 1] + (find {:a 1 :b 2} :b) [:b 2] + (find {:a 1 :b 2} :c) nil + + (find {} nil) nil + (find {:a 1} nil) nil + (find {:a 1 :b 2} nil) nil )) + + +(deftest test-contains? + ; contains? is designed to work preferably on maps and sets + (are [x y] (= x y) + (contains? {} :a) false + (contains? {} nil) false + + (contains? {:a 1} :a) true + (contains? {:a 1} :b) false + (contains? {:a 1} nil) false + + (contains? {:a 1 :b 2} :a) true + (contains? {:a 1 :b 2} :b) true + (contains? {:a 1 :b 2} :c) false + (contains? {:a 1 :b 2} nil) false + + ; sets + (contains? #{} 1) false + (contains? #{} nil) false + + (contains? #{1} 1) true + (contains? #{1} 2) false + (contains? #{1} nil) false + + (contains? #{1 2 3} 1) true + (contains? #{1 2 3} 3) true + (contains? #{1 2 3} 10) false + (contains? #{1 2 3} nil) false) + + ; numerically indexed collections (e.g. vectors and Java arrays) + ; => test if the numeric key is WITHIN THE RANGE OF INDEXES + (are [x y] (= x y) + (contains? [] 0) false + (contains? [] -1) false + (contains? [] 1) false + + (contains? [1] 0) true + (contains? [1] -1) false + (contains? [1] 1) false + + (contains? [1 2 3] 0) true + (contains? [1 2 3] 2) true + (contains? [1 2 3] 3) false + (contains? [1 2 3] -1) false + + ; arrays + (contains? (into-array []) 0) false + (contains? (into-array []) -1) false + (contains? (into-array []) 1) false + + (contains? (into-array [1]) 0) true + (contains? (into-array [1]) -1) false + (contains? (into-array [1]) 1) false + + (contains? (into-array [1 2 3]) 0) true + (contains? (into-array [1 2 3]) 2) true + (contains? (into-array [1 2 3]) 3) false + (contains? (into-array [1 2 3]) -1) false) + + ; 'contains?' operates constant or logarithmic time, + ; it WILL NOT perform a linear search for a value. + (are [x] (= x false) + (contains? '(1 2 3) 0) + (contains? '(1 2 3) 1) + (contains? '(1 2 3) 3) + (contains? '(1 2 3) 10) + (contains? '(1 2 3) nil) + (contains? '(1 2 3) ()) )) + + +(deftest test-keys + (are [x y] (= x y) ; other than map data structures + (keys ()) nil + (keys []) nil + (keys #{}) nil + (keys "") nil ) + + (are [x y] (= x y) + ; (class {:a 1}) => clojure.lang.PersistentArrayMap + (keys {}) nil + (keys {:a 1}) '(:a) + (diff (keys {:a 1 :b 2}) '(:a :b)) nil ; (keys {:a 1 :b 2}) '(:a :b) + + ; (class (sorted-map :a 1)) => clojure.lang.PersistentTreeMap + (keys (sorted-map)) nil + (keys (sorted-map :a 1)) '(:a) + (diff (keys (sorted-map :a 1 :b 2)) '(:a :b)) nil ; (keys (sorted-map :a 1 :b 2)) '(:a :b) + + ; (class (hash-map :a 1)) => clojure.lang.PersistentHashMap + (keys (hash-map)) nil + (keys (hash-map :a 1)) '(:a) + (diff (keys (hash-map :a 1 :b 2)) '(:a :b)) nil )) ; (keys (hash-map :a 1 :b 2)) '(:a :b) + + +(deftest test-vals + (are [x y] (= x y) ; other than map data structures + (vals ()) nil + (vals []) nil + (vals #{}) nil + (vals "") nil ) + + (are [x y] (= x y) + ; (class {:a 1}) => clojure.lang.PersistentArrayMap + (vals {}) nil + (vals {:a 1}) '(1) + (diff (vals {:a 1 :b 2}) '(1 2)) nil ; (vals {:a 1 :b 2}) '(1 2) + + ; (class (sorted-map :a 1)) => clojure.lang.PersistentTreeMap + (vals (sorted-map)) nil + (vals (sorted-map :a 1)) '(1) + (diff (vals (sorted-map :a 1 :b 2)) '(1 2)) nil ; (vals (sorted-map :a 1 :b 2)) '(1 2) + + ; (class (hash-map :a 1)) => clojure.lang.PersistentHashMap + (vals (hash-map)) nil + (vals (hash-map :a 1)) '(1) + (diff (vals (hash-map :a 1 :b 2)) '(1 2)) nil )) ; (vals (hash-map :a 1 :b 2)) '(1 2) + + +(deftest test-key + (are [x] (= (key (first (hash-map x :value))) x) + nil + false true + 0 42 + 0.0 3.14 + 2/3 + 0M 1M + \c + "" "abc" + 'sym + :kw + () '(1 2) + [] [1 2] + {} {:a 1 :b 2} + #{} #{1 2} )) + + +(deftest test-val + (are [x] (= (val (first (hash-map :key x))) x) + nil + false true + 0 42 + 0.0 3.14 + 2/3 + 0M 1M + \c + "" "abc" + 'sym + :kw + () '(1 2) + [] [1 2] + {} {:a 1 :b 2} + #{} #{1 2} )) + + +;; *** Sets *** + +(deftest test-hash-set + (are [x] (set? x) + #{} + #{1 2} + (hash-set) + (hash-set 1 2) ) + + ; order isn't important + (are [x y] (= x y) + #{1 2} #{2 1} + #{3 1 2} #{1 2 3} + (hash-set 1 2) (hash-set 2 1) + (hash-set 3 1 2) (hash-set 1 2 3) ) + + ; equal and unique + (are [x] (and (= (hash-set x) #{x}) + (= (hash-set x x) #{x})) + nil + false true + 0 42 + 0.0 3.14 + 2/3 + 0M 1M + \c + "" "abc" + 'sym + :kw + () '(1 2) + [] [1 2] + {} {:a 1 :b 2} + #{} #{1 2} ) + + (are [x y] (= x y) + ; equal classes + (class #{}) (class (hash-set)) + (class #{1 2}) (class (hash-set 1 2)) + + ; creating + (hash-set) #{} + (hash-set 1) #{1} + (hash-set 1 2) #{1 2} + + ; nesting + (hash-set 1 (hash-set 2 3) (hash-set 3 (hash-set 4 5 (hash-set 6 (hash-set 7))))) + #{1 #{2 3} #{3 #{4 5 #{6 #{7}}}}} + + ; different data structures + (hash-set true false nil) + #{true false nil} + (hash-set 1 2.5 2/3 "ab" \x 'cd :kw) + #{1 2.5 2/3 "ab" \x 'cd :kw} + (hash-set (list 1 2) [3 4] {:a 1 :b 2} #{:c :d}) + #{'(1 2) [3 4] {:a 1 :b 2} #{:c :d}} + + ; evaluation + (hash-set (+ 1 2) [(+ 2 3) :a] (hash-set (* 2 3) 8)) + #{3 [5 :a] #{6 8}} + + ; special cases + (hash-set nil) #{nil} + (hash-set 1 nil) #{1 nil} + (hash-set nil 2) #{nil 2} + (hash-set #{}) #{#{}} + (hash-set 1 #{}) #{1 #{}} + (hash-set #{} 2) #{#{} 2} )) + + +(deftest test-sorted-set + ; only compatible types can be used + (is (thrown? ClassCastException (sorted-set 1 "a"))) + (is (thrown? ClassCastException (sorted-set '(1 2) [3 4]))) + + ; creates set? + (are [x] (set? x) + (sorted-set) + (sorted-set 1 2) ) + + ; equal and unique + (are [x] (and (= (sorted-set x) #{x}) + (= (sorted-set x x) (sorted-set x))) + nil + false true + 0 42 + 0.0 3.14 + 2/3 + 0M 1M + \c + "" "abc" + 'sym + :kw + () ; '(1 2) + [] [1 2] + {} ; {:a 1 :b 2} + #{} ; #{1 2} + ) + ; cannot be cast to java.lang.Comparable + (is (thrown? ClassCastException (sorted-set '(1 2) '(1 2)))) + (is (thrown? ClassCastException (sorted-set {:a 1 :b 2} {:a 1 :b 2}))) + (is (thrown? ClassCastException (sorted-set #{1 2} #{1 2}))) + + (are [x y] (= x y) + ; generating + (sorted-set) #{} + (sorted-set 1) #{1} + (sorted-set 1 2) #{1 2} + + ; sorting + (seq (sorted-set 5 4 3 2 1)) '(1 2 3 4 5) + + ; special cases + (sorted-set nil) #{nil} + (sorted-set 1 nil) #{nil 1} + (sorted-set nil 2) #{nil 2} + (sorted-set #{}) #{#{}} )) + + +(deftest test-set + ; set? + (are [x] (set? (set x)) + () '(1 2) + [] [1 2] + #{} #{1 2} + {} {:a 1 :b 2} + (into-array []) (into-array [1 2]) + "" "abc" ) + + ; unique + (are [x] (= (set [x x]) #{x}) + nil + false true + 0 42 + 0.0 3.14 + 2/3 + 0M 1M + \c + "" "abc" + 'sym + :kw + () '(1 2) + [] [1 2] + {} {:a 1 :b 2} + #{} #{1 2} ) + + ; conversion + (are [x y] (= (set x) y) + () #{} + '(1 2) #{1 2} + + [] #{} + [1 2] #{1 2} + + #{} #{} ; identity + #{1 2} #{1 2} ; identity + + {} #{} + {:a 1 :b 2} #{[:a 1] [:b 2]} + + (into-array []) #{} + (into-array [1 2]) #{1 2} + + "" #{} + "abc" #{\a \b \c} )) + + +(deftest test-disj + ; doesn't work on lists, vectors or maps + (is (thrown? ClassCastException (disj '(1 2) 1))) + (is (thrown? ClassCastException (disj [1 2] 1))) + (is (thrown? ClassCastException (disj {:a 1} :a))) + + ; identity + (are [x] (= (disj x) x) + #{} + #{1 2 3} + ; different data types + #{nil + false true + 0 42 + 0.0 3.14 + 2/3 + 0M 1M + \c + "" "abc" + 'sym + :kw + [] [1 2] + {} {:a 1 :b 2} + #{} #{1 2}} ) + + ; type identity + (are [x] (= (class (disj x)) (class x)) + (hash-set) + (hash-set 1 2) + (sorted-set) + (sorted-set 1 2) ) + + (are [x y] (= x y) + (disj #{} :a) #{} + (disj #{} :a :b) #{} + + (disj #{:a} :a) #{} + (disj #{:a} :a :b) #{} + (disj #{:a} :c) #{:a} + + (disj #{:a :b :c :d} :a) #{:b :c :d} + (disj #{:a :b :c :d} :a :d) #{:b :c} + (disj #{:a :b :c :d} :a :b :c) #{:d} + (disj #{:a :b :c :d} :d :a :c :b) #{} + + (disj #{nil} :a) #{nil} + (disj #{nil} #{}) #{nil} + (disj #{nil} nil) #{} + + (disj #{#{}} nil) #{#{}} + (disj #{#{}} #{}) #{} + (disj #{#{nil}} #{nil}) #{} )) + + diff --git a/test/clojure/test_clojure/evaluation.clj b/test/clojure/test_clojure/evaluation.clj new file mode 100644 index 00000000..283896c5 --- /dev/null +++ b/test/clojure/test_clojure/evaluation.clj @@ -0,0 +1,229 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + + +;; Tests for the Clojure functions documented at the URL: +;; +;; http://clojure.org/Evaluation +;; +;; by J. McConnell +;; Created 22 October 2008 + +(ns clojure.test-clojure.evaluation + (:use clojure.test)) + +(import '(java.lang Boolean) + '(clojure.lang Compiler Compiler$CompilerException)) + +(defmacro test-that + "Provides a useful way for specifying the purpose of tests. If the first-level + forms are lists that make a call to a clojure.test function, it supplies the + purpose as the msg argument to those functions. Otherwise, the purpose just + acts like a comment and the forms are run unchanged." + [purpose & test-forms] + (let [tests (map + #(if (= (:ns (meta (resolve (first %)))) + (the-ns 'clojure.test)) + (concat % (list purpose)) + %) + test-forms)] + `(do ~@tests))) + +(deftest Eval + (is (= (eval '(+ 1 2 3)) (Compiler/eval '(+ 1 2 3)))) + (is (= (eval '(list 1 2 3)) '(1 2 3))) + (is (= (eval '(list + 1 2 3)) (list clojure.core/+ 1 2 3))) + (test-that "Non-closure fns are supported as code" + (is (= (eval (eval '(list + 1 2 3))) 6))) + (is (= (eval (list '+ 1 2 3)) 6))) + +; not using Clojure's RT/classForName since a bug in it could hide a bug in +; eval's resolution +(defn class-for-name [name] + (java.lang.Class/forName name)) + +(defmacro in-test-ns [& body] + `(binding [*ns* *ns*] + (in-ns 'clojure.test-clojure.evaluation) + ~@body)) + +;;; Literals tests ;;; + +(defmacro #^{:private true} evaluates-to-itself? [expr] + `(let [v# ~expr + q# (quote ~expr)] + (is (= (eval q#) q#) (str q# " does not evaluate to itself")))) + +(deftest Literals + ; Strings, numbers, characters, nil and keywords should evaluate to themselves + (evaluates-to-itself? "test") + (evaluates-to-itself? "test + multi-line + string") + (evaluates-to-itself? 1) + (evaluates-to-itself? 1.0) + (evaluates-to-itself? 1.123456789) + (evaluates-to-itself? 1/2) + (evaluates-to-itself? 1M) + (evaluates-to-itself? 999999999999999999) + (evaluates-to-itself? \a) + (evaluates-to-itself? \newline) + (evaluates-to-itself? nil) + (evaluates-to-itself? :test) + ; Boolean literals should evaluate to Boolean.{TRUE|FALSE} + (is (identical? (eval true) Boolean/TRUE)) + (is (identical? (eval false) Boolean/FALSE))) + +;;; Symbol resolution tests ;;; + +(def foo "abc") +(in-ns 'resolution-test) +(def bar 123) +(def #^{:private true} baz 456) +(in-ns 'clojure.test-clojure.evaluation) + +(defn a-match? [re s] (not (nil? (re-matches re s)))) + +(defmacro throws-with-msg + ([re form] `(throws-with-msg ~re ~form Exception)) + ([re form x] `(throws-with-msg + ~re + ~form + ~(if (instance? Exception x) x Exception) + ~(if (instance? String x) x nil))) + ([re form class msg] + `(let [ex# (try + ~form + (catch ~class e# e#) + (catch Exception e# + (let [cause# (.getCause e#)] + (if (= ~class (class cause#)) cause# (throw e#)))))] + (is (a-match? ~re (.toString ex#)) + (or ~msg + (str "Expected exception that matched " (pr-str ~re) + ", but got exception with message: \"" ex#)))))) + +(deftest SymbolResolution + (test-that + "If a symbol is namespace-qualified, the evaluated value is the value + of the binding of the global var named by the symbol" + (is (= (eval 'resolution-test/bar) 123))) + + (test-that + "It is an error if there is no global var named by the symbol" + (throws-with-msg + #".*Unable to resolve symbol: bar.*" (eval 'bar))) + + (test-that + "It is an error if the symbol reference is to a non-public var in a + different namespace" + (throws-with-msg + #".*resolution-test/baz is not public.*" + (eval 'resolution-test/baz) + Compiler$CompilerException)) + + (test-that + "If a symbol is package-qualified, its value is the Java class named by the + symbol" + (is (= (eval 'java.lang.Math) (class-for-name "java.lang.Math")))) + + (test-that + "If a symbol is package-qualified, it is an error if there is no Class named + by the symbol" + (is (thrown? Compiler$CompilerException (eval 'java.lang.FooBar)))) + + (test-that + "If a symbol is not qualified, the following applies, in this order: + + 1. If it names a special form it is considered a special form, and must + be utilized accordingly. + + 2. A lookup is done in the current namespace to see if there is a mapping + from the symbol to a class. If so, the symbol is considered to name a + Java class object. + + 3. If in a local scope (i.e. in a function definition), a lookup is done + to see if it names a local binding (e.g. a function argument or + let-bound name). If so, the value is the value of the local binding. + + 4. A lookup is done in the current namespace to see if there is a mapping + from the symbol to a var. If so, the value is the value of the binding + of the var referred-to by the symbol. + + 5. It is an error." + + ; First + (doall (for [form '(def if do let quote var fn loop recur throw try + monitor-enter monitor-exit)] + (is (thrown? Compiler$CompilerException (eval form))))) + (let [if "foo"] + (is (thrown? Compiler$CompilerException (eval 'if))) + + ; Second + (is (= (eval 'Boolean) (class-for-name "java.lang.Boolean")))) + (let [Boolean "foo"] + (is (= (eval 'Boolean) (class-for-name "java.lang.Boolean")))) + + ; Third + (is (= (eval '(let [foo "bar"] foo)) "bar")) + + ; Fourth + (in-test-ns (is (= (eval 'foo) "abc"))) + (is (thrown? Compiler$CompilerException (eval 'bar))) ; not in this namespace + + ; Fifth + (is (thrown? Compiler$CompilerException (eval 'foobar))))) + +;;; Metadata tests ;;; + +(defstruct struct-with-symbols (with-meta 'k {:a "A"})) + +(deftest Metadata + (test-that + "If a Symbol has metadata, it will not be part of the resulting value" + (is (not (nil? (meta (with-meta (symbol "test") {:doc "doc"}))))) + (is (nil? (meta (eval (with-meta (symbol "test") {:doc "doc"})))))) + + (test-that + "find returns key symbols and their metadata" + (let [s (struct struct-with-symbols 1)] + (is (= {:a "A"} (meta (first (find s 'k)))))))) + +;;; Collections tests ;;; +(def x 1) +(def y 2) + +(deftest Collections + (in-test-ns + (test-that + "Vectors and Maps yield vectors and (hash) maps whose contents are the + evaluated values of the objects they contain." + (is (= (eval '[x y 3]) [1 2 3])) + (is (= (eval '{:x x :y y :z 3}) {:x 1 :y 2 :z 3})) + (is (instance? clojure.lang.IPersistentMap (eval '{:x x :y y}))))) + + (in-test-ns + (test-that + "Metadata maps yield maps whose contents are the evaluated values of + the objects they contain. If a vector or map has metadata, the evaluated + metadata map will become the metadata of the resulting value." + (is (= (eval #^{:x x} '[x y]) #^{:x 1} [1 2])))) + + (test-that + "An empty list () evaluates to an empty list." + (is (= (eval '()) ())) + (is (empty? (eval ()))) + (is (= (eval (list)) ()))) + + (test-that + "Non-empty lists are considered calls" + (is (thrown? Compiler$CompilerException (eval '(1 2 3)))))) + +(deftest Macros) + +(deftest Loading) diff --git a/test/clojure/test_clojure/for.clj b/test/clojure/test_clojure/for.clj new file mode 100644 index 00000000..d8ebed26 --- /dev/null +++ b/test/clojure/test_clojure/for.clj @@ -0,0 +1,123 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +;; Tests for the Clojure 'for' macro +;; +;; by Chouser +;; Created Dec 2008 + +(ns clojure.test-clojure.for + (:use clojure.test)) + +(deftest Docstring-Example + (is (= (take 100 (for [x (range 100000000) + y (range 1000000) :while (< y x)] + [x y])) + '([1 0] [2 0] [2 1] [3 0] [3 1] [3 2] [4 0] [4 1] [4 2] [4 3] + [5 0] [5 1] [5 2] [5 3] [5 4] + [6 0] [6 1] [6 2] [6 3] [6 4] [6 5] + [7 0] [7 1] [7 2] [7 3] [7 4] [7 5] [7 6] + [8 0] [8 1] [8 2] [8 3] [8 4] [8 5] [8 6] [8 7] + [9 0] [9 1] [9 2] [9 3] [9 4] [9 5] [9 6] [9 7] [9 8] + [10 0] [10 1] [10 2] [10 3] [10 4] [10 5] [10 6] [10 7] [10 8] [10 9] + [11 0] [11 1] [11 2] [11 3] [11 4] [11 5] [11 6] [11 7] [11 8] [11 9] + [11 10] + [12 0] [12 1] [12 2] [12 3] [12 4] [12 5] [12 6] [12 7] [12 8] [12 9] + [12 10] [12 11] + [13 0] [13 1] [13 2] [13 3] [13 4] [13 5] [13 6] [13 7] [13 8] [13 9] + [13 10] [13 11] [13 12] + [14 0] [14 1] [14 2] [14 3] [14 4] [14 5] [14 6] [14 7] [14 8])))) + +(defmacro deftest-both [txt & ises] + `(do + (deftest ~(symbol (str "For-" txt)) ~@ises) + (deftest ~(symbol (str "Doseq-" txt)) + ~@(map (fn [[x-is [x-= [x-for binds body] value]]] + (when (and (= x-is 'is) (= x-= '=) (= x-for 'for)) + `(is (= (let [acc# (atom [])] + (doseq ~binds (swap! acc# conj ~body)) + @acc#) + ~value)))) + ises)))) + +(deftest-both When + (is (= (for [x (range 10) :when (odd? x)] x) '(1 3 5 7 9))) + (is (= (for [x (range 4) y (range 4) :when (odd? y)] [x y]) + '([0 1] [0 3] [1 1] [1 3] [2 1] [2 3] [3 1] [3 3]))) + (is (= (for [x (range 4) y (range 4) :when (odd? x)] [x y]) + '([1 0] [1 1] [1 2] [1 3] [3 0] [3 1] [3 2] [3 3]))) + (is (= (for [x (range 4) :when (odd? x) y (range 4)] [x y]) + '([1 0] [1 1] [1 2] [1 3] [3 0] [3 1] [3 2] [3 3]))) + (is (= (for [x (range 5) y (range 5) :when (< x y)] [x y]) + '([0 1] [0 2] [0 3] [0 4] [1 2] [1 3] [1 4] [2 3] [2 4] [3 4])))) + +(defn only + "Returns a lazy seq of increasing ints starting at 0. Trying to get + the nth+1 value of the seq throws an exception. This is meant to + help detecting over-eagerness in lazy seq consumers." + [n] + (lazy-cat (range n) + (throw (Exception. "consumer went too far in lazy seq")))) + +(deftest-both While + (is (= (for [x (only 6) :while (< x 5)] x) '(0 1 2 3 4))) + (is (= (for [x (range 4) y (only 4) :while (< y 3)] [x y]) + '([0 0] [0 1] [0 2] [1 0] [1 1] [1 2] + [2 0] [2 1] [2 2] [3 0] [3 1] [3 2]))) + (is (= (for [x (range 4) y (range 4) :while (< x 3)] [x y]) + '([0 0] [0 1] [0 2] [0 3] [1 0] [1 1] [1 2] [1 3] + [2 0] [2 1] [2 2] [2 3]))) + (is (= (for [x (only 4) :while (< x 3) y (range 4)] [x y]) + '([0 0] [0 1] [0 2] [0 3] [1 0] [1 1] [1 2] [1 3] + [2 0] [2 1] [2 2] [2 3]))) + (is (= (for [x (range 4) y (range 4) :while (even? x)] [x y]) + '([0 0] [0 1] [0 2] [0 3] [2 0] [2 1] [2 2] [2 3]))) + (is (= (for [x (only 2) :while (even? x) y (range 4)] [x y]) + '([0 0] [0 1] [0 2] [0 3]))) + (is (= (for [x (range 4) y (only 4) :while (< y x)] [x y]) + '([1 0] [2 0] [2 1] [3 0] [3 1] [3 2])))) + +(deftest-both While-and-When + (is (= (for [x (only 6) :while (< x 5) y (range 4) :when (odd? y)] [x y]) + '([0 1] [0 3] [1 1] [1 3] [2 1] [2 3] [3 1] [3 3] [4 1] [4 3]))) + (is (= (for [x (range 4) :when (odd? x) y (only 6) :while (< y 5)] [x y]) + '([1 0] [1 1] [1 2] [1 3] [1 4] [3 0] [3 1] [3 2] [3 3] [3 4]))) + (is (= (for [x (only 6) :while (< x 5) y (range 4) :when (odd? (+ x y))] + [x y]) + '([0 1] [0 3] [1 0] [1 2] [2 1] [2 3] [3 0] [3 2] [4 1] [4 3]))) + (is (= (for [x (range 4) :when (odd? x) y (only 2) :while (odd? (+ x y))] + [x y]) + '([1 0] [3 0])))) + +(deftest-both While-and-When-Same-Binding + (is (= (for [x (only 6) :while (< x 5) :when (odd? x)] x) '(1 3))) + (is (= (for [x (only 6) + :while (< x 5) ; if :while is false, :when should not be evaled + :when (do (if (< x 5) (odd? x)))] x) '(1 3))) + (is (= (for [a (range -2 5) + :when (not= a 0) ; :when may guard :while + :while (> (Math/abs (/ 1.0 a)) 1/3)] a) '(-2 -1 1 2)))) + +(deftest-both Nesting + (is (= (for [x '(a b) y (interpose x '(1 2)) z (list x y)] [x y z]) + '([a 1 a] [a 1 1] [a a a] [a a a] [a 2 a] [a 2 2] + [b 1 b] [b 1 1] [b b b] [b b b] [b 2 b] [b 2 2]))) + (is (= (for [x ['a nil] y [x 'b]] [x y]) + '([a a] [a b] [nil nil] [nil b])))) + +(deftest-both Destructuring + (is (= (for [{:syms [a b c]} (map #(zipmap '(a b c) (range % 5)) (range 3)) + x [a b c]] + (Integer. (str a b c x))) + '(120 121 122 1231 1232 1233 2342 2343 2344)))) + +(deftest-both Let + (is (= (for [x (range 3) y (range 3) :let [z (+ x y)] :when (odd? z)] [x y z]) + '([0 1 1] [1 0 1] [1 2 3] [2 1 3]))) + (is (= (for [x (range 6) :let [y (rem x 2)] :when (even? y) z [8 9]] [x z]) + '([0 8] [0 9] [2 8] [2 9] [4 8] [4 9])))) diff --git a/test/clojure/test_clojure/java_interop.clj b/test/clojure/test_clojure/java_interop.clj new file mode 100644 index 00000000..699ba361 --- /dev/null +++ b/test/clojure/test_clojure/java_interop.clj @@ -0,0 +1,407 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +; Author: Frantisek Sodomka + + +(ns clojure.test-clojure.java-interop + (:use clojure.test)) + +; http://clojure.org/java_interop +; http://clojure.org/compilation + + +(deftest test-dot + ; (.instanceMember instance args*) + (are [x] (= x "FRED") + (.toUpperCase "fred") + (. "fred" toUpperCase) + (. "fred" (toUpperCase)) ) + + (are [x] (= x true) + (.startsWith "abcde" "ab") + (. "abcde" startsWith "ab") + (. "abcde" (startsWith "ab")) ) + + ; (.instanceMember Classname args*) + (are [x] (= x "java.lang.String") + (.getName String) + (. (identity String) getName) + (. (identity String) (getName)) ) + + ; (Classname/staticMethod args*) + (are [x] (= x 7) + (Math/abs -7) + (. Math abs -7) + (. Math (abs -7)) ) + + ; Classname/staticField + (are [x] (= x 2147483647) + Integer/MAX_VALUE + (. Integer MAX_VALUE) )) + + +(deftest test-double-dot + (is (= (.. System (getProperties) (get "os.name")) + (. (. System (getProperties)) (get "os.name"))))) + + +(deftest test-doto + (let [m (doto (new java.util.HashMap) + (.put "a" 1) + (.put "b" 2))] + (are [x y] (= x y) + (class m) java.util.HashMap + m {"a" 1 "b" 2} ))) + + +(deftest test-new + ; Integer + (are [expr cls value] (and (= (class expr) cls) + (= expr value)) + (new java.lang.Integer 42) java.lang.Integer 42 + (java.lang.Integer. 123) java.lang.Integer 123 ) + + ; Date + (are [x] (= (class x) java.util.Date) + (new java.util.Date) + (java.util.Date.) )) + + +(deftest test-instance? + ; evaluation + (are [x y] (= x y) + (instance? java.lang.Integer (+ 1 2)) true + (instance? java.lang.Long (+ 1 2)) false ) + + ; different types + (are [type literal] (instance? literal type) + 1 java.lang.Integer + 1.0 java.lang.Double + 1M java.math.BigDecimal + \a java.lang.Character + "a" java.lang.String ) + + ; it is an int, nothing else + (are [x y] (= (instance? x 42) y) + java.lang.Integer true + java.lang.Long false + java.lang.Character false + java.lang.String false )) + + +; set! + +; memfn + + +(deftest test-bean + (let [b (bean java.awt.Color/black)] + (are [x y] (= x y) + (map? b) true + + (:red b) 0 + (:green b) 0 + (:blue b) 0 + (:RGB b) -16777216 + + (:alpha b) 255 + (:transparency b) 1 + + (:class b) java.awt.Color ))) + + +; proxy, proxy-super + + +(deftest test-bases + (are [x y] (= x y) + (bases java.lang.Math) + (list java.lang.Object) + (bases java.lang.Integer) + (list java.lang.Number java.lang.Comparable) )) + +(deftest test-supers + (are [x y] (= x y) + (supers java.lang.Math) + #{java.lang.Object} + (supers java.lang.Integer) + #{java.lang.Number java.lang.Object + java.lang.Comparable java.io.Serializable} )) + + +; Arrays: [alength] aget aset [make-array to-array into-array to-array-2d aclone] +; [float-array, int-array, etc] +; amap, areduce + +(defmacro deftest-type-array [type-array type] + `(deftest ~(symbol (str "test-" type-array)) + ; correct type + (is (= (class (first (~type-array [1 2]))) (class (~type 1)))) + + ; given size (and empty) + (are [x] (and (= (alength (~type-array x)) x) + (= (vec (~type-array x)) (repeat x 0))) + 0 1 5 ) + + ; copy of a sequence + (are [x] (and (= (alength (~type-array x)) (count x)) + (= (vec (~type-array x)) x)) +;; [] ;; ERROR + [1] + [1 -2 3 0 5] ) + + ; given size and init-value + (are [x] (and (= (alength (~type-array x 42)) x) + (= (vec (~type-array x 42)) (repeat x 42))) + 0 1 5 ) + + ; given size and init-seq + (are [x y z] (and (= (alength (~type-array x y)) x) + (= (vec (~type-array x y)) z)) + 0 [] [] + 0 [1] [] + 0 [1 2 3] [] + 1 [] [0] + 1 [1] [1] + 1 [1 2 3] [1] + 5 [] [0 0 0 0 0] + 5 [1] [1 0 0 0 0] + 5 [1 2 3] [1 2 3 0 0] + 5 [1 2 3 4 5] [1 2 3 4 5] + 5 [1 2 3 4 5 6 7] [1 2 3 4 5] ))) + +(deftest-type-array int-array int) +(deftest-type-array long-array long) +(deftest-type-array float-array float) +(deftest-type-array double-array double) + +; separate test for exceptions (doesn't work with above macro...) +(deftest test-type-array-exceptions + (are [x] (thrown? NegativeArraySizeException x) + (int-array -1) + (long-array -1) + (float-array -1) + (double-array -1) )) + + +(deftest test-make-array + ; negative size + (is (thrown? NegativeArraySizeException (make-array Integer -1))) + + ; one-dimensional + (are [x] (= (alength (make-array Integer x)) x) + 0 1 5 ) + + (let [a (make-array Integer 5)] + (aset a 3 42) + (are [x y] (= x y) + (aget a 3) 42 + (class (aget a 3)) Integer )) + + ; multi-dimensional + (let [a (make-array Integer 3 2 4)] + (aset a 0 1 2 987) + (are [x y] (= x y) + (alength a) 3 + (alength (first a)) 2 + (alength (first (first a))) 4 + + (aget a 0 1 2) 987 + (class (aget a 0 1 2)) Integer ))) + + +(deftest test-to-array + (let [v [1 "abc" :kw \c []] + a (to-array v)] + (are [x y] (= x y) + ; length + (alength a) (count v) + + ; content + (vec a) v + (class (aget a 0)) (class (nth v 0)) + (class (aget a 1)) (class (nth v 1)) + (class (aget a 2)) (class (nth v 2)) + (class (aget a 3)) (class (nth v 3)) + (class (aget a 4)) (class (nth v 4)) )) + + ; different kinds of collections + (are [x] (and (= (alength (to-array x)) (count x)) + (= (vec (to-array x)) (vec x))) + () + '(1 2) + [] + [1 2] + (sorted-set) + (sorted-set 1 2) + + (int-array 0) + (int-array [1 2 3]) + + (to-array []) + (to-array [1 2 3]) )) + + +(deftest test-into-array + ; compatible types only + (is (thrown? IllegalArgumentException (into-array [1 "abc" :kw]))) + (is (thrown? IllegalArgumentException (into-array [1.2 4]))) + (is (thrown? IllegalArgumentException (into-array [(byte 2) (short 3)]))) + + ; simple case + (let [v [1 2 3 4 5] + a (into-array v)] + (are [x y] (= x y) + (alength a) (count v) + (vec a) v + (class (first a)) (class (first v)) )) + + ; given type + (let [a (into-array Integer/TYPE [(byte 2) (short 3) (int 4)])] + (are [x] (= x Integer) + (class (aget a 0)) + (class (aget a 1)) + (class (aget a 2)) )) + + ; different kinds of collections + (are [x] (and (= (alength (into-array x)) (count x)) + (= (vec (into-array x)) (vec x)) + (= (alength (into-array Integer/TYPE x)) (count x)) + (= (vec (into-array Integer/TYPE x)) (vec x))) + () + '(1 2) + [] + [1 2] + (sorted-set) + (sorted-set 1 2) + + (int-array 0) + (int-array [1 2 3]) + + (to-array []) + (to-array [1 2 3]) )) + + +(deftest test-to-array-2d + ; needs to be a collection of collection(s) + (is (thrown? Exception (to-array-2d [1 2 3]))) + + ; ragged array + (let [v [[1] [2 3] [4 5 6]] + a (to-array-2d v)] + (are [x y] (= x y) + (alength a) (count v) + (alength (aget a 0)) (count (nth v 0)) + (alength (aget a 1)) (count (nth v 1)) + (alength (aget a 2)) (count (nth v 2)) + + (vec (aget a 0)) (nth v 0) + (vec (aget a 1)) (nth v 1) + (vec (aget a 2)) (nth v 2) )) + + ; empty array + (let [a (to-array-2d [])] + (are [x y] (= x y) + (alength a) 0 + (vec a) [] ))) + + +(deftest test-alength + (are [x] (= (alength x) 0) + (int-array 0) + (long-array 0) + (float-array 0) + (double-array 0) + (make-array Integer/TYPE 0) + (to-array []) + (into-array []) + (to-array-2d []) ) + + (are [x] (= (alength x) 1) + (int-array 1) + (long-array 1) + (float-array 1) + (double-array 1) + (make-array Integer/TYPE 1) + (to-array [1]) + (into-array [1]) + (to-array-2d [[1]]) ) + + (are [x] (= (alength x) 3) + (int-array 3) + (long-array 3) + (float-array 3) + (double-array 3) + (make-array Integer/TYPE 3) + (to-array [1 "a" :k]) + (into-array [1 2 3]) + (to-array-2d [[1] [2 3] [4 5 6]]) )) + + +(deftest test-aclone + ; clone all arrays except 2D + (are [x] (and (= (alength (aclone x)) (alength x)) + (= (vec (aclone x)) (vec x))) + (int-array 0) + (long-array 0) + (float-array 0) + (double-array 0) + (make-array Integer/TYPE 0) + (to-array []) + (into-array []) + + (int-array [1 2 3]) + (long-array [1 2 3]) + (float-array [1 2 3]) + (double-array [1 2 3]) + (make-array Integer/TYPE 3) + (to-array [1 "a" :k]) + (into-array [1 2 3]) ) + + ; clone 2D + (are [x] (and (= (alength (aclone x)) (alength x)) + (= (map alength (aclone x)) (map alength x)) + (= (map vec (aclone x)) (map vec x))) + (to-array-2d []) + (to-array-2d [[1] [2 3] [4 5 6]]) )) + + +; Type Hints, *warn-on-reflection* +; #^ints, #^floats, #^longs, #^doubles + +; Coercions: [int, long, float, double, char, boolean, short, byte] +; num +; ints/longs/floats/doubles + +(deftest test-boolean + (are [x y] (and (instance? java.lang.Boolean (boolean x)) + (= (boolean x) y)) + nil false + false false + true true + + 0 true + 1 true + () true + [1] true + + "" true + \space true + :kw true )) + + +(deftest test-char + ; int -> char + (is (instance? java.lang.Character (char 65))) + + ; char -> char + (is (instance? java.lang.Character (char \a))) + (is (= (char \a) \a))) + +;; Note: More coercions in numbers.clj diff --git a/test/clojure/test_clojure/logic.clj b/test/clojure/test_clojure/logic.clj new file mode 100644 index 00000000..b097468e --- /dev/null +++ b/test/clojure/test_clojure/logic.clj @@ -0,0 +1,205 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +; Author: Frantisek Sodomka + +;; +;; Created 1/29/2009 + +(ns clojure.test-clojure.logic + (:use clojure.test + [clojure.test-clojure.test-utils :only (exception)])) + + +;; *** Tests *** + +(deftest test-if + ; true/false/nil + (are [x y] (= x y) + (if true :t) :t + (if true :t :f) :t + (if true :t (exception)) :t + + (if false :t) nil + (if false :t :f) :f + (if false (exception) :f) :f + + (if nil :t) nil + (if nil :t :f) :f + (if nil (exception) :f) :f ) + + ; zero/empty is true + (are [x] (= (if x :t :f) :t) + (byte 0) + (short 0) + (int 0) + (long 0) + (bigint 0) + (float 0) + (double 0) + (bigdec 0) + + 0/2 + "" + #"" + (symbol "") + + () + [] + {} + #{} + (into-array []) ) + + ; anything except nil/false is true + (are [x] (= (if x :t :f) :t) + (byte 2) + (short 2) + (int 2) + (long 2) + (bigint 2) + (float 2) + (double 2) + (bigdec 2) + + 2/3 + \a + "abc" + #"a*b" + 'abc + :kw + + '(1 2) + [1 2] + {:a 1 :b 2} + #{1 2} + (into-array [1 2]) + + (new java.util.Date) )) + + +(deftest test-nil-punning + (are [x y] (= (if x :no :yes) y) + (first []) :yes + (next [1]) :yes + (rest [1]) :no + + (butlast [1]) :yes + + (seq nil) :yes + (seq []) :yes + + (sequence nil) :no + (sequence []) :no + + (lazy-seq nil) :no + (lazy-seq []) :no + + (filter #(> % 10) [1 2 3]) :no + (map identity []) :no + (apply concat []) :no + + (concat) :no + (concat []) :no + + (reverse nil) :no + (reverse []) :no + + (sort nil) :no + (sort []) :no )) + + +(deftest test-and + (are [x y] (= x y) + (and) true + (and true) true + (and nil) nil + (and false) false + + (and true nil) nil + (and true false) false + + (and 1 true :kw 'abc "abc") "abc" + + (and 1 true :kw nil 'abc "abc") nil + (and 1 true :kw nil (exception) 'abc "abc") nil + + (and 1 true :kw 'abc "abc" false) false + (and 1 true :kw 'abc "abc" false (exception)) false )) + + +(deftest test-or + (are [x y] (= x y) + (or) nil + (or true) true + (or nil) nil + (or false) false + + (or nil false true) true + (or nil false 1 2) 1 + (or nil false "abc" :kw) "abc" + + (or false nil) nil + (or nil false) false + (or nil nil nil false) false + + (or nil true false) true + (or nil true (exception) false) true + (or nil false "abc" (exception)) "abc" )) + + +(deftest test-not + (is (thrown? IllegalArgumentException (not))) + (are [x] (= (not x) true) + nil + false ) + (are [x] (= (not x) false) + true + + ; numbers + 0 + 0.0 + 42 + 1.2 + 0/2 + 2/3 + + ; characters + \space + \tab + \a + + ; strings + "" + "abc" + + ; regexes + #"" + #"a*b" + + ; symbols + (symbol "") + 'abc + + ; keywords + :kw + + ; collections/arrays + () + '(1 2) + [] + [1 2] + {} + {:a 1 :b 2} + #{} + #{1 2} + (into-array []) + (into-array [1 2]) + + ; Java objects + (new java.util.Date) )) + diff --git a/test/clojure/test_clojure/macros.clj b/test/clojure/test_clojure/macros.clj new file mode 100644 index 00000000..711130ef --- /dev/null +++ b/test/clojure/test_clojure/macros.clj @@ -0,0 +1,18 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +; Author: Frantisek Sodomka + +(ns clojure.test-clojure.macros + (:use clojure.test)) + +; http://clojure.org/macros + +; -> +; defmacro definline macroexpand-1 macroexpand + diff --git a/test/clojure/test_clojure/metadata.clj b/test/clojure/test_clojure/metadata.clj new file mode 100644 index 00000000..3130b489 --- /dev/null +++ b/test/clojure/test_clojure/metadata.clj @@ -0,0 +1,19 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +; Author: Frantisek Sodomka + +(ns clojure.test-clojure.metadata + (:use clojure.test)) + + +; http://clojure.org/metadata + +; meta +; with-meta + diff --git a/test/clojure/test_clojure/multimethods.clj b/test/clojure/test_clojure/multimethods.clj new file mode 100644 index 00000000..8c27034a --- /dev/null +++ b/test/clojure/test_clojure/multimethods.clj @@ -0,0 +1,27 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +; Author: Frantisek Sodomka + +(ns clojure.test-clojure.multimethods + (:use clojure.test)) + +; http://clojure.org/multimethods + +; defmulti +; defmethod +; remove-method +; prefer-method +; methods +; prefers + +; derive, [underive] +; isa? +; parents, ancestors, descendants +; make-hierarchy + diff --git a/test/clojure/test_clojure/ns_libs.clj b/test/clojure/test_clojure/ns_libs.clj new file mode 100644 index 00000000..a9a2145c --- /dev/null +++ b/test/clojure/test_clojure/ns_libs.clj @@ -0,0 +1,28 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +; Author: Frantisek Sodomka + +(ns clojure.test-clojure.ns-libs + (:use clojure.test)) + +; http://clojure.org/namespaces + +; in-ns ns create-ns +; alias import intern refer +; all-ns find-ns +; ns-name ns-aliases ns-imports ns-interns ns-map ns-publics ns-refers +; resolve ns-resolve namespace +; ns-unalias ns-unmap remove-ns + + +; http://clojure.org/libs + +; require use +; loaded-libs + diff --git a/test/clojure/test_clojure/numbers.clj b/test/clojure/test_clojure/numbers.clj new file mode 100644 index 00000000..9f3cfdb2 --- /dev/null +++ b/test/clojure/test_clojure/numbers.clj @@ -0,0 +1,391 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +; Author: Stephen C. Gilardi +;; scgilardi (gmail) +;; Created 30 October 2008 +;; + +(ns clojure.test-clojure.numbers + (:use clojure.test)) + + +; TODO: +; == +; and more... + + +;; *** Types *** + +(deftest Coerced-Byte + (let [v (byte 3)] + (are [x] + (instance? Byte v) + (number? v) + (integer? v) + (rational? v)))) + +(deftest Coerced-Short + (let [v (short 3)] + (are [x] + (instance? Short v) + (number? v) + (integer? v) + (rational? v)))) + +(deftest Coerced-Integer + (let [v (int 3)] + (are [x] + (instance? Integer v) + (number? v) + (integer? v) + (rational? v)))) + +(deftest Coerced-Long + (let [v (long 3)] + (are [x] + (instance? Long v) + (number? v) + (integer? v) + (rational? v)))) + +(deftest Coerced-BigInteger + (let [v (bigint 3)] + (are [x] + (instance? BigInteger v) + (number? v) + (integer? v) + (rational? v)))) + +(deftest Coerced-Float + (let [v (float 3)] + (are [x] + (instance? Float v) + (number? v) + (float? v)))) + +(deftest Coerced-Double + (let [v (double 3)] + (are [x] + (instance? Double v) + (number? v) + (float? v)))) + +(deftest Coerced-BigDecimal + (let [v (bigdec 3)] + (are [x] + (instance? BigDecimal v) + (number? v) + (decimal? v) + (not (float? v))))) + + +;; *** Functions *** + +(defonce DELTA 1e-12) + +(deftest test-add + (are [x y] (= x y) + (+) 0 + (+ 1) 1 + (+ 1 2) 3 + (+ 1 2 3) 6 + + (+ -1) -1 + (+ -1 -2) -3 + (+ -1 +2 -3) -2 + + (+ 1 -1) 0 + (+ -1 1) 0 + + (+ 2/3) 2/3 + (+ 2/3 1) 5/3 + (+ 2/3 1/3) 1 ) + + (are [x y] (< (- x y) DELTA) + (+ 1.2) 1.2 + (+ 1.1 2.4) 3.5 + (+ 1.1 2.2 3.3) 6.6 ) + + (is (> (+ Integer/MAX_VALUE 10) Integer/MAX_VALUE)) ; no overflow + (is (thrown? ClassCastException (+ "ab" "cd"))) ) ; no string concatenation + + +(deftest test-subtract + (is (thrown? IllegalArgumentException (-))) + (are [x y] (= x y) + (- 1) -1 + (- 1 2) -1 + (- 1 2 3) -4 + + (- -2) 2 + (- 1 -2) 3 + (- 1 -2 -3) 6 + + (- 1 1) 0 + (- -1 -1) 0 + + (- 2/3) -2/3 + (- 2/3 1) -1/3 + (- 2/3 1/3) 1/3 ) + + (are [x y] (< (- x y) DELTA) + (- 1.2) -1.2 + (- 2.2 1.1) 1.1 + (- 6.6 2.2 1.1) 3.3 ) + + (is (< (- Integer/MIN_VALUE 10) Integer/MIN_VALUE)) ) ; no underflow + + +(deftest test-multiply + (are [x y] (= x y) + (*) 1 + (* 2) 2 + (* 2 3) 6 + (* 2 3 4) 24 + + (* -2) -2 + (* 2 -3) -6 + (* 2 -3 -1) 6 + + (* 1/2) 1/2 + (* 1/2 1/3) 1/6 + (* 1/2 1/3 -1/4) -1/24 ) + + (are [x y] (< (- x y) DELTA) + (* 1.2) 1.2 + (* 2.0 1.2) 2.4 + (* 3.5 2.0 1.2) 8.4 ) + + (is (> (* 3 (int (/ Integer/MAX_VALUE 2.0))) Integer/MAX_VALUE)) ) ; no overflow + + +(deftest test-divide + (are [x y] (= x y) + (/ 1) 1 + (/ 2) 1/2 + (/ 3 2) 3/2 + (/ 4 2) 2 + (/ 24 3 2) 4 + (/ 24 3 2 -1) -4 + + (/ -1) -1 + (/ -2) -1/2 + (/ -3 -2) 3/2 + (/ -4 -2) 2 + (/ -4 2) -2 ) + + (are [x y] (< (- x y) DELTA) + (/ 4.5 3) 1.5 + (/ 4.5 3.0 3.0) 0.5 ) + + (is (thrown? ArithmeticException (/ 0))) + (is (thrown? ArithmeticException (/ 2 0))) + (is (thrown? IllegalArgumentException (/))) ) + + +;; mod +;; http://en.wikipedia.org/wiki/Modulo_operation +;; http://mathforum.org/library/drmath/view/52343.html +;; +;; is mod correct? +;; http://groups.google.com/group/clojure/browse_frm/thread/2a0ee4d248f3d131# +;; +;; Issue 23: mod (modulo) operator +;; http://code.google.com/p/clojure/issues/detail?id=23 + +(deftest test-mod + ; wrong number of args + (is (thrown? IllegalArgumentException (mod))) + (is (thrown? IllegalArgumentException (mod 1))) + (is (thrown? IllegalArgumentException (mod 3 2 1))) + + ; divide by zero + (is (thrown? ArithmeticException (mod 9 0))) + (is (thrown? ArithmeticException (mod 0 0))) + + (are [x y] (= x y) + (mod 4 2) 0 + (mod 3 2) 1 + (mod 6 4) 2 + (mod 0 5) 0 + + (mod 2 1/2) 0 + (mod 2/3 1/2) 1/6 + (mod 1 2/3) 1/3 + + (mod 4.0 2.0) 0.0 + (mod 4.5 2.0) 0.5 + + ; |num| > |div|, num != k * div + (mod 42 5) 2 ; (42 / 5) * 5 + (42 mod 5) = 8 * 5 + 2 = 42 + (mod 42 -5) -3 ; (42 / -5) * (-5) + (42 mod -5) = -9 * (-5) + (-3) = 42 + (mod -42 5) 3 ; (-42 / 5) * 5 + (-42 mod 5) = -9 * 5 + 3 = -42 + (mod -42 -5) -2 ; (-42 / -5) * (-5) + (-42 mod -5) = 8 * (-5) + (-2) = -42 + + ; |num| > |div|, num = k * div + (mod 9 3) 0 ; (9 / 3) * 3 + (9 mod 3) = 3 * 3 + 0 = 9 + (mod 9 -3) 0 + (mod -9 3) 0 + (mod -9 -3) 0 + + ; |num| < |div| + (mod 2 5) 2 ; (2 / 5) * 5 + (2 mod 5) = 0 * 5 + 2 = 2 + (mod 2 -5) -3 ; (2 / -5) * (-5) + (2 mod -5) = (-1) * (-5) + (-3) = 2 + (mod -2 5) 3 ; (-2 / 5) * 5 + (-2 mod 5) = (-1) * 5 + 3 = -2 + (mod -2 -5) -2 ; (-2 / -5) * (-5) + (-2 mod -5) = 0 * (-5) + (-2) = -2 + + ; num = 0, div != 0 + (mod 0 3) 0 ; (0 / 3) * 3 + (0 mod 3) = 0 * 3 + 0 = 0 + (mod 0 -3) 0 + ) +) + +;; rem & quot +;; http://en.wikipedia.org/wiki/Remainder + +(deftest test-rem + ; wrong number of args + (is (thrown? IllegalArgumentException (rem))) + (is (thrown? IllegalArgumentException (rem 1))) + (is (thrown? IllegalArgumentException (rem 3 2 1))) + + ; divide by zero + (is (thrown? ArithmeticException (rem 9 0))) + (is (thrown? ArithmeticException (rem 0 0))) + + (are [x y] (= x y) + (rem 4 2) 0 + (rem 3 2) 1 + (rem 6 4) 2 + (rem 0 5) 0 + + (rem 2 1/2) 0 + (rem 2/3 1/2) 1/6 + (rem 1 2/3) 1/3 + + (rem 4.0 2.0) 0.0 + (rem 4.5 2.0) 0.5 + + ; |num| > |div|, num != k * div + (rem 42 5) 2 ; (8 * 5) + 2 == 42 + (rem 42 -5) 2 ; (-8 * -5) + 2 == 42 + (rem -42 5) -2 ; (-8 * 5) + -2 == -42 + (rem -42 -5) -2 ; (8 * -5) + -2 == -42 + + ; |num| > |div|, num = k * div + (rem 9 3) 0 + (rem 9 -3) 0 + (rem -9 3) 0 + (rem -9 -3) 0 + + ; |num| < |div| + (rem 2 5) 2 + (rem 2 -5) 2 + (rem -2 5) -2 + (rem -2 -5) -2 + + ; num = 0, div != 0 + (rem 0 3) 0 + (rem 0 -3) 0 + ) +) + +(deftest test-quot + ; wrong number of args + (is (thrown? IllegalArgumentException (quot))) + (is (thrown? IllegalArgumentException (quot 1))) + (is (thrown? IllegalArgumentException (quot 3 2 1))) + + ; divide by zero + (is (thrown? ArithmeticException (quot 9 0))) + (is (thrown? ArithmeticException (quot 0 0))) + + (are [x y] (= x y) + (quot 4 2) 2 + (quot 3 2) 1 + (quot 6 4) 1 + (quot 0 5) 0 + + (quot 2 1/2) 4 + (quot 2/3 1/2) 1 + (quot 1 2/3) 1 + + (quot 4.0 2.0) 2.0 + (quot 4.5 2.0) 2.0 + + ; |num| > |div|, num != k * div + (quot 42 5) 8 ; (8 * 5) + 2 == 42 + (quot 42 -5) -8 ; (-8 * -5) + 2 == 42 + (quot -42 5) -8 ; (-8 * 5) + -2 == -42 + (quot -42 -5) 8 ; (8 * -5) + -2 == -42 + + ; |num| > |div|, num = k * div + (quot 9 3) 3 + (quot 9 -3) -3 + (quot -9 3) -3 + (quot -9 -3) 3 + + ; |num| < |div| + (quot 2 5) 0 + (quot 2 -5) 0 + (quot -2 5) 0 + (quot -2 -5) 0 + + ; num = 0, div != 0 + (quot 0 3) 0 + (quot 0 -3) 0 + ) +) + + +;; *** Predicates *** + +;; pos? zero? neg? + +(deftest test-pos?-zero?-neg? + (let [nums [[(byte 2) (byte 0) (byte -2)] + [(short 3) (short 0) (short -3)] + [(int 4) (int 0) (int -4)] + [(long 5) (long 0) (long -5)] + [(bigint 6) (bigint 0) (bigint -6)] + [(float 7) (float 0) (float -7)] + [(double 8) (double 0) (double -8)] + [(bigdec 9) (bigdec 0) (bigdec -9)] + [2/3 0 -2/3]] + pred-result [[pos? [true false false]] + [zero? [false true false]] + [neg? [false false true]]] ] + (doseq [pr pred-result] + (doseq [n nums] + (is (= (map (first pr) n) (second pr)) + (pr-str (first pr) n)))))) + + +;; even? odd? + +(deftest test-even? + (are [x] + (even? -4) + (not (even? -3)) + (even? 0) + (not (even? 5)) + (even? 8)) + (is (thrown? ArithmeticException (even? 1/2))) + (is (thrown? ArithmeticException (even? (double 10))))) + +(deftest test-odd? + (are [x] + (not (odd? -4)) + (odd? -3) + (not (odd? 0)) + (odd? 5) + (not (odd? 8))) + (is (thrown? ArithmeticException (odd? 1/2))) + (is (thrown? ArithmeticException (odd? (double 10))))) + diff --git a/test/clojure/test_clojure/other_functions.clj b/test/clojure/test_clojure/other_functions.clj new file mode 100644 index 00000000..43214921 --- /dev/null +++ b/test/clojure/test_clojure/other_functions.clj @@ -0,0 +1,60 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +; Author: Frantisek Sodomka + + +(ns clojure.test-clojure.other-functions + (:use clojure.test)) + +; http://clojure.org/other_functions + +; [= not= (tests in data_structures.clj and elsewhere)] + + +(deftest test-identity + ; exactly 1 argument needed + (is (thrown? IllegalArgumentException (identity))) + (is (thrown? IllegalArgumentException (identity 1 2))) + + (are [x] (= (identity x) x) + nil + false true + 0 42 + 0.0 3.14 + 2/3 + 0M 1M + \c + "" "abc" + 'sym + :kw + () '(1 2) + [] [1 2] + {} {:a 1 :b 2} + #{} #{1 2} ) + + ; evaluation + (are [x y] (= (identity x) y) + (+ 1 2) 3 + (> 5 0) true )) + + +; time assert comment doc + +; partial +; comp +; complement +; constantly + +; Printing +; pr prn print println newline +; pr-str prn-str print-str println-str [with-out-str (vars.clj)] + +; Regex Support +; re-matcher re-find re-matches re-groups re-seq + diff --git a/test/clojure/test_clojure/parallel.clj b/test/clojure/test_clojure/parallel.clj new file mode 100644 index 00000000..fb98d605 --- /dev/null +++ b/test/clojure/test_clojure/parallel.clj @@ -0,0 +1,29 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +; Author: Frantisek Sodomka + + +(ns clojure.test-clojure.parallel + (:use clojure.test)) + +;; !! Tests for the parallel library will be in a separate file clojure_parallel.clj !! + +; future-call +; future +; pmap +; pcalls +; pvalues + + +;; pmap +;; +(deftest pmap-does-its-thing + ;; regression fixed in r1218; was OutOfMemoryError + (is (= '(1) (pmap inc [0])))) + diff --git a/test/clojure/test_clojure/predicates.clj b/test/clojure/test_clojure/predicates.clj new file mode 100644 index 00000000..8e68c757 --- /dev/null +++ b/test/clojure/test_clojure/predicates.clj @@ -0,0 +1,142 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +; Author: Frantisek Sodomka + +;; +;; Created 1/28/2009 + +(ns clojure.test-clojure.predicates + (:use clojure.test)) + + +;; *** Type predicates *** + +(def myvar 42) + +(def sample-data { + :nil nil + + :bool-true true + :bool-false false + + :byte (byte 7) + :short (short 7) + :int (int 7) + :long (long 7) + :bigint (bigint 7) + :float (float 7) + :double (double 7) + :bigdec (bigdec 7) + + :ratio 2/3 + + :character \a + :symbol 'abc + :keyword :kw + + :empty-string "" + :empty-regex #"" + :empty-list () + :empty-lazy-seq (lazy-seq nil) + :empty-vector [] + :empty-map {} + :empty-set #{} + :empty-array (into-array []) + + :string "abc" + :regex #"a*b" + :list '(1 2 3) + :lazy-seq (lazy-seq [1 2 3]) + :vector [1 2 3] + :map {:a 1 :b 2 :c 3} + :set #{1 2 3} + :array (into-array [1 2 3]) + + :fn (fn [x] (* 2 x)) + + :class java.util.Date + :object (new java.util.Date) + + :var (var myvar) + :delay (delay (+ 1 2)) +}) + + +(def type-preds { + nil? [:nil] + + true? [:bool-true] + false? [:bool-false] + ; boolean? + + integer? [:byte :short :int :long :bigint] + float? [:float :double] + decimal? [:bigdec] + ratio? [:ratio] + rational? [:byte :short :int :long :bigint :ratio :bigdec] + number? [:byte :short :int :long :bigint :ratio :bigdec :float :double] + + ; character? + symbol? [:symbol] + keyword? [:keyword] + + string? [:empty-string :string] + ; regex? + + list? [:empty-list :list] + vector? [:empty-vector :vector] + map? [:empty-map :map] + set? [:empty-set :set] + + coll? [:empty-list :list + :empty-lazy-seq :lazy-seq + :empty-vector :vector + :empty-map :map + :empty-set :set] + + seq? [:empty-list :list + :empty-lazy-seq :lazy-seq] + ; array? + + fn? [:fn] + ifn? [:fn + :empty-vector :vector :empty-map :map :empty-set :set + :keyword :symbol :var] + + class? [:class] + var? [:var] + delay? [:delay] +}) + + +;; Test all type predicates against all data types +;; +(defn- get-fn-name [f] + (str + (apply str (nthnext (first (.split (str f) "_")) + (count "clojure.core$"))) + "?")) + +(deftest test-type-preds + (doseq [tp type-preds] + (doseq [dt sample-data] + (if (some #(= % (first dt)) (second tp)) + (is ((first tp) (second dt)) + (pr-str (list (get-fn-name (first tp)) (second dt)))) + (is (not ((first tp) (second dt))) + (pr-str (list 'not (list (get-fn-name (first tp)) (second dt))))))))) + + +;; Additional tests: +;; http://groups.google.com/group/clojure/browse_thread/thread/537761a06edb4b06/bfd4f0705b746a38 +;; +(deftest test-string?-more + (are (not (string? _)) + (new java.lang.StringBuilder "abc") + (new java.lang.StringBuffer "xyz"))) diff --git a/test/clojure/test_clojure/printer.clj b/test/clojure/test_clojure/printer.clj new file mode 100644 index 00000000..ecee4b6e --- /dev/null +++ b/test/clojure/test_clojure/printer.clj @@ -0,0 +1,83 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +; Author: Stephen C. Gilardi + +;; clojure.test-clojure.printer +;; +;; scgilardi (gmail) +;; Created 29 October 2008 + +(ns clojure.test-clojure.printer + (:use clojure.test)) + +(deftest print-length-empty-seq + (let [coll () val "()"] + (is (= val (binding [*print-length* 0] (print-str coll)))) + (is (= val (binding [*print-length* 1] (print-str coll)))))) + +(deftest print-length-seq + (let [coll (range 5) + length-val '((0 "(...)") + (1 "(0 ...)") + (2 "(0 1 ...)") + (3 "(0 1 2 ...)") + (4 "(0 1 2 3 ...)") + (5 "(0 1 2 3 4)"))] + (doseq [[length val] length-val] + (binding [*print-length* length] + (is (= val (print-str coll))))))) + +(deftest print-length-empty-vec + (let [coll [] val "[]"] + (is (= val (binding [*print-length* 0] (print-str coll)))) + (is (= val (binding [*print-length* 1] (print-str coll)))))) + +(deftest print-length-vec + (let [coll [0 1 2 3 4] + length-val '((0 "[...]") + (1 "[0 ...]") + (2 "[0 1 ...]") + (3 "[0 1 2 ...]") + (4 "[0 1 2 3 ...]") + (5 "[0 1 2 3 4]"))] + (doseq [[length val] length-val] + (binding [*print-length* length] + (is (= val (print-str coll))))))) + +(deftest print-level-seq + (let [coll '(0 (1 (2 (3 (4))))) + level-val '((0 "#") + (1 "(0 #)") + (2 "(0 (1 #))") + (3 "(0 (1 (2 #)))") + (4 "(0 (1 (2 (3 #))))") + (5 "(0 (1 (2 (3 (4)))))"))] + (doseq [[level val] level-val] + (binding [*print-level* level] + (is (= val (print-str coll))))))) + +(deftest print-level-length-coll + (let [coll '(if (member x y) (+ (first x) 3) (foo (a b c d "Baz"))) + level-length-val + '((0 1 "#") + (1 1 "(if ...)") + (1 2 "(if # ...)") + (1 3 "(if # # ...)") + (1 4 "(if # # #)") + (2 1 "(if ...)") + (2 2 "(if (member x ...) ...)") + (2 3 "(if (member x y) (+ # 3) ...)") + (3 2 "(if (member x ...) ...)") + (3 3 "(if (member x y) (+ (first x) 3) ...)") + (3 4 "(if (member x y) (+ (first x) 3) (foo (a b c d ...)))") + (3 5 "(if (member x y) (+ (first x) 3) (foo (a b c d Baz)))"))] + (doseq [[level length val] level-length-val] + (binding [*print-level* level + *print-length* length] + (is (= val (print-str coll))))))) diff --git a/test/clojure/test_clojure/reader.clj b/test/clojure/test_clojure/reader.clj new file mode 100644 index 00000000..b04543a9 --- /dev/null +++ b/test/clojure/test_clojure/reader.clj @@ -0,0 +1,299 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +; Author: Stephen C. Gilardi + +;; +;; Tests for the Clojure functions documented at the URL: +;; +;; http://clojure.org/Reader +;; +;; scgilardi (gmail) +;; Created 22 October 2008 + +(ns clojure.test-clojure.reader + (:use clojure.test)) + +;; Symbols + +(deftest Symbols + (is (= 'abc (symbol "abc"))) + (is (= '*+!-_? (symbol "*+!-_?"))) + (is (= 'abc:def:ghi (symbol "abc:def:ghi"))) + (is (= 'abc/def (symbol "abc" "def"))) + (is (= 'abc.def/ghi (symbol "abc.def" "ghi"))) + (is (= 'abc/def.ghi (symbol "abc" "def.ghi"))) + (is (= 'abc:def/ghi:jkl.mno (symbol "abc:def" "ghi:jkl.mno"))) + (is (instance? clojure.lang.Symbol 'alphabet)) + ) + +;; Literals + +(deftest Literals + ; 'nil 'false 'true are reserved by Clojure and are not symbols + (is (= 'nil nil)) + (is (= 'false false)) + (is (= 'true true)) ) + +;; Strings + +(deftest Strings + (is (= "abcde" (str \a \b \c \d \e))) + (is (= "abc + def" (str \a \b \c \newline \space \space \d \e \f))) + ) + +;; Numbers + +(deftest Numbers + + ; Read Integer + (is (instance? Integer 2147483647)) + (is (instance? Integer +1)) + (is (instance? Integer 1)) + (is (instance? Integer +0)) + (is (instance? Integer 0)) + (is (instance? Integer -0)) + (is (instance? Integer -1)) + (is (instance? Integer -2147483648)) + + ; Read Long + (is (instance? Long 2147483648)) + (is (instance? Long -2147483649)) + (is (instance? Long 9223372036854775807)) + (is (instance? Long -9223372036854775808)) + + ;; Numeric constants of different types don't wash out. Regression fixed in + ;; r1157. Previously the compiler saw 0 and 0.0 as the same constant and + ;; caused the sequence to be built of Doubles. + (let [x 0.0] + (let [sequence (loop [i 0 l '()] + (if (< i 5) + (recur (inc i) (conj l i)) + l))] + (is (= [4 3 2 1 0] sequence)) + (is (every? #(instance? Integer %) + sequence)))) + + ; Read BigInteger + (is (instance? BigInteger 9223372036854775808)) + (is (instance? BigInteger -9223372036854775809)) + (is (instance? BigInteger 10000000000000000000000000000000000000000000000000)) + (is (instance? BigInteger -10000000000000000000000000000000000000000000000000)) + + ; Read Double + (is (instance? Double +1.0e+1)) + (is (instance? Double +1.e+1)) + (is (instance? Double +1e+1)) + + (is (instance? Double +1.0e1)) + (is (instance? Double +1.e1)) + (is (instance? Double +1e1)) + + (is (instance? Double +1.0e-1)) + (is (instance? Double +1.e-1)) + (is (instance? Double +1e-1)) + + (is (instance? Double 1.0e+1)) + (is (instance? Double 1.e+1)) + (is (instance? Double 1e+1)) + + (is (instance? Double 1.0e1)) + (is (instance? Double 1.e1)) + (is (instance? Double 1e1)) + + (is (instance? Double 1.0e-1)) + (is (instance? Double 1.e-1)) + (is (instance? Double 1e-1)) + + (is (instance? Double -1.0e+1)) + (is (instance? Double -1.e+1)) + (is (instance? Double -1e+1)) + + (is (instance? Double -1.0e1)) + (is (instance? Double -1.e1)) + (is (instance? Double -1e1)) + + (is (instance? Double -1.0e-1)) + (is (instance? Double -1.e-1)) + (is (instance? Double -1e-1)) + + (is (instance? Double +1.0)) + (is (instance? Double +1.)) + + (is (instance? Double 1.0)) + (is (instance? Double 1.)) + + (is (instance? Double +0.0)) + (is (instance? Double +0.)) + + (is (instance? Double 0.0)) + (is (instance? Double 0.)) + + (is (instance? Double -0.0)) + (is (instance? Double -0.)) + + (is (instance? Double -1.0)) + (is (instance? Double -1.)) + + ; Read BigDecimal + (is (instance? BigDecimal 9223372036854775808M)) + (is (instance? BigDecimal -9223372036854775809M)) + (is (instance? BigDecimal 2147483647M)) + (is (instance? BigDecimal +1M)) + (is (instance? BigDecimal 1M)) + (is (instance? BigDecimal +0M)) + (is (instance? BigDecimal 0M)) + (is (instance? BigDecimal -0M)) + (is (instance? BigDecimal -1M)) + (is (instance? BigDecimal -2147483648M)) + + (is (instance? BigDecimal +1.0e+1M)) + (is (instance? BigDecimal +1.e+1M)) + (is (instance? BigDecimal +1e+1M)) + + (is (instance? BigDecimal +1.0e1M)) + (is (instance? BigDecimal +1.e1M)) + (is (instance? BigDecimal +1e1M)) + + (is (instance? BigDecimal +1.0e-1M)) + (is (instance? BigDecimal +1.e-1M)) + (is (instance? BigDecimal +1e-1M)) + + (is (instance? BigDecimal 1.0e+1M)) + (is (instance? BigDecimal 1.e+1M)) + (is (instance? BigDecimal 1e+1M)) + + (is (instance? BigDecimal 1.0e1M)) + (is (instance? BigDecimal 1.e1M)) + (is (instance? BigDecimal 1e1M)) + + (is (instance? BigDecimal 1.0e-1M)) + (is (instance? BigDecimal 1.e-1M)) + (is (instance? BigDecimal 1e-1M)) + + (is (instance? BigDecimal -1.0e+1M)) + (is (instance? BigDecimal -1.e+1M)) + (is (instance? BigDecimal -1e+1M)) + + (is (instance? BigDecimal -1.0e1M)) + (is (instance? BigDecimal -1.e1M)) + (is (instance? BigDecimal -1e1M)) + + (is (instance? BigDecimal -1.0e-1M)) + (is (instance? BigDecimal -1.e-1M)) + (is (instance? BigDecimal -1e-1M)) + + (is (instance? BigDecimal +1.0M)) + (is (instance? BigDecimal +1.M)) + + (is (instance? BigDecimal 1.0M)) + (is (instance? BigDecimal 1.M)) + + (is (instance? BigDecimal +0.0M)) + (is (instance? BigDecimal +0.M)) + + (is (instance? BigDecimal 0.0M)) + (is (instance? BigDecimal 0.M)) + + (is (instance? BigDecimal -0.0M)) + (is (instance? BigDecimal -0.M)) + + (is (instance? BigDecimal -1.0M)) + (is (instance? BigDecimal -1.M)) +) + +;; Characters + +(deftest t-Characters) + +;; nil + +(deftest t-nil) + +;; Booleans + +(deftest t-Booleans) + +;; Keywords + +(deftest t-Keywords) + +;; Lists + +(deftest t-Lists) + +;; Vectors + +(deftest t-Vectors) + +;; Maps + +(deftest t-Maps) + +;; Sets + +(deftest t-Sets) + +;; Macro characters + +;; Quote (') + +(deftest t-Quote) + +;; Character (\) + +(deftest t-Character) + +;; Comment (;) + +(deftest t-Comment) + +;; Meta (^) + +(deftest t-Meta) + +;; Deref (@) + +(deftest t-Deref) + +;; Dispatch (#) + +;; #{} - see Sets above + +;; Regex patterns (#"pattern") + +(deftest t-Regex) + +;; Metadata (#^) + +(deftest t-Metadata) + +;; Var-quote (#') + +(deftest t-Var-quote) + +;; Anonymous function literal (#()) + +(deftest t-Anonymouns-function-literal) + +;; Syntax-quote (`, note, the "backquote" character), Unquote (~) and +;; Unquote-splicing (~@) + +(deftest t-Syntax-quote + (are (= _1 _2) + `() () ; was NPE before SVN r1337 + )) + +;; (read) +;; (read stream) +;; (read stream eof-is-error) +;; (read stream eof-is-error eof-value) +;; (read stream eof-is-error eof-value is-recursive) + +(deftest t-read) diff --git a/test/clojure/test_clojure/refs.clj b/test/clojure/test_clojure/refs.clj new file mode 100644 index 00000000..767a34dd --- /dev/null +++ b/test/clojure/test_clojure/refs.clj @@ -0,0 +1,22 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +; Author: Frantisek Sodomka + + +(ns clojure.test-clojure.refs + (:use clojure.test)) + +; http://clojure.org/refs + +; ref +; deref, @-reader-macro +; dosync io! +; ensure ref-set alter commute +; set-validator get-validator + diff --git a/test/clojure/test_clojure/sequences.clj b/test/clojure/test_clojure/sequences.clj new file mode 100644 index 00000000..4f813cc6 --- /dev/null +++ b/test/clojure/test_clojure/sequences.clj @@ -0,0 +1,984 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +; Author: Frantisek Sodomka + + +(ns clojure.test-clojure.sequences + (:use clojure.test)) + + +;; *** Tests *** + +; TODO: +; apply, map, reduce, filter, remove +; and more... + + +(deftest test-equality + ; lazy sequences + (are [x y] (= x y) + ; fixed SVN 1288 - LazySeq and EmptyList equals/equiv + ; http://groups.google.com/group/clojure/browse_frm/thread/286d807be9cae2a5# + (map inc nil) () + (map inc ()) () + (map inc []) () + (map inc #{}) () + (map inc {}) () )) + + +(deftest test-lazy-seq + (are [x] (seq? x) + (lazy-seq nil) + (lazy-seq []) + (lazy-seq [1 2])) + + (are [x y] (= x y) + (lazy-seq nil) () + (lazy-seq [nil]) '(nil) + + (lazy-seq ()) () + (lazy-seq []) () + (lazy-seq #{}) () + (lazy-seq {}) () + (lazy-seq "") () + (lazy-seq (into-array [])) () + + (lazy-seq (list 1 2)) '(1 2) + (lazy-seq [1 2]) '(1 2) + (lazy-seq (sorted-set 1 2)) '(1 2) + (lazy-seq (sorted-map :a 1 :b 2)) '([:a 1] [:b 2]) + (lazy-seq "abc") '(\a \b \c) + (lazy-seq (into-array [1 2])) '(1 2) )) + + +(deftest test-seq + (is (not (seq? (seq [])))) + (is (seq? (seq [1 2]))) + + (are [x y] (= x y) + (seq nil) nil + (seq [nil]) '(nil) + + (seq ()) nil + (seq []) nil + (seq #{}) nil + (seq {}) nil + (seq "") nil + (seq (into-array [])) nil + + (seq (list 1 2)) '(1 2) + (seq [1 2]) '(1 2) + (seq (sorted-set 1 2)) '(1 2) + (seq (sorted-map :a 1 :b 2)) '([:a 1] [:b 2]) + (seq "abc") '(\a \b \c) + (seq (into-array [1 2])) '(1 2) )) + + +(deftest test-cons + (is (thrown? IllegalArgumentException (cons 1 2))) + (are [x y] (= x y) + (cons 1 nil) '(1) + (cons nil nil) '(nil) + + (cons \a nil) '(\a) + (cons \a "") '(\a) + (cons \a "bc") '(\a \b \c) + + (cons 1 ()) '(1) + (cons 1 '(2 3)) '(1 2 3) + + (cons 1 []) [1] + (cons 1 [2 3]) [1 2 3] + + (cons 1 #{}) '(1) + (cons 1 (sorted-set 2 3)) '(1 2 3) + + (cons 1 (into-array [])) '(1) + (cons 1 (into-array [2 3])) '(1 2 3) )) + + +(deftest test-empty + (are [x y] (and (= (empty x) y) + (= (class (empty x)) (class y))) + nil nil + + () () + '(1 2) () + + [] [] + [1 2] [] + + {} {} + {:a 1 :b 2} {} + + #{} #{} + #{1 2} #{} + + (seq ()) nil ; (seq ()) => nil + (seq '(1 2)) () + + (seq []) nil ; (seq []) => nil + (seq [1 2]) () + + (seq "") nil ; (seq "") => nil + (seq "ab") () + + (lazy-seq ()) () + (lazy-seq '(1 2)) () + + (lazy-seq []) () + (lazy-seq [1 2]) () + + ; non-coll, non-seq => nil + 42 nil + 1.2 nil + "abc" nil )) + + +(deftest test-not-empty + ; empty coll/seq => nil + (are [x] (= (not-empty x) nil) + () + [] + {} + #{} + (seq ()) + (seq []) + (lazy-seq ()) + (lazy-seq []) ) + + ; non-empty coll/seq => identity + (are [x] (and (= (not-empty x) x) + (= (class (not-empty x)) (class x))) + '(1 2) + [1 2] + {:a 1} + #{1 2} + (seq '(1 2)) + (seq [1 2]) + (lazy-seq '(1 2)) + (lazy-seq [1 2]) )) + + +(deftest test-first + (is (thrown? IllegalArgumentException (first))) + (is (thrown? IllegalArgumentException (first true))) + (is (thrown? IllegalArgumentException (first false))) + (is (thrown? IllegalArgumentException (first 1))) + (is (thrown? IllegalArgumentException (first 1 2))) + (is (thrown? IllegalArgumentException (first \a))) + (is (thrown? IllegalArgumentException (first 's))) + (is (thrown? IllegalArgumentException (first :k))) + (are [x y] (= x y) + (first nil) nil + + ; string + (first "") nil + (first "a") \a + (first "abc") \a + + ; list + (first ()) nil + (first '(1)) 1 + (first '(1 2 3)) 1 + + (first '(nil)) nil + (first '(1 nil)) 1 + (first '(nil 2)) nil + (first '(())) () + (first '(() nil)) () + (first '(() 2 nil)) () + + ; vector + (first []) nil + (first [1]) 1 + (first [1 2 3]) 1 + + (first [nil]) nil + (first [1 nil]) 1 + (first [nil 2]) nil + (first [[]]) [] + (first [[] nil]) [] + (first [[] 2 nil]) [] + + ; set + (first #{}) nil + (first #{1}) 1 + (first (sorted-set 1 2 3)) 1 + + (first #{nil}) nil + (first (sorted-set 1 nil)) nil + (first (sorted-set nil 2)) nil + (first #{#{}}) #{} + (first (sorted-set #{} nil)) nil + ;(first (sorted-set #{} 2 nil)) nil + + ; map + (first {}) nil + (first (sorted-map :a 1)) '(:a 1) + (first (sorted-map :a 1 :b 2 :c 3)) '(:a 1) + + ; array + (first (into-array [])) nil + (first (into-array [1])) 1 + (first (into-array [1 2 3])) 1 + (first (to-array [nil])) nil + (first (to-array [1 nil])) 1 + (first (to-array [nil 2])) nil )) + + +(deftest test-next + (is (thrown? IllegalArgumentException (next))) + (is (thrown? IllegalArgumentException (next true))) + (is (thrown? IllegalArgumentException (next false))) + (is (thrown? IllegalArgumentException (next 1))) + (is (thrown? IllegalArgumentException (next 1 2))) + (is (thrown? IllegalArgumentException (next \a))) + (is (thrown? IllegalArgumentException (next 's))) + (is (thrown? IllegalArgumentException (next :k))) + (are [x y] (= x y) + (next nil) nil + + ; string + (next "") nil + (next "a") nil + (next "abc") '(\b \c) + + ; list + (next ()) nil + (next '(1)) nil + (next '(1 2 3)) '(2 3) + + (next '(nil)) nil + (next '(1 nil)) '(nil) + (next '(1 ())) '(()) + (next '(nil 2)) '(2) + (next '(())) nil + (next '(() nil)) '(nil) + (next '(() 2 nil)) '(2 nil) + + ; vector + (next []) nil + (next [1]) nil + (next [1 2 3]) [2 3] + + (next [nil]) nil + (next [1 nil]) [nil] + (next [1 []]) [[]] + (next [nil 2]) [2] + (next [[]]) nil + (next [[] nil]) [nil] + (next [[] 2 nil]) [2 nil] + + ; set + (next #{}) nil + (next #{1}) nil + (next (sorted-set 1 2 3)) '(2 3) + + (next #{nil}) nil + (next (sorted-set 1 nil)) '(1) + (next (sorted-set nil 2)) '(2) + (next #{#{}}) nil + (next (sorted-set #{} nil)) '(#{}) + ;(next (sorted-set #{} 2 nil)) #{} + + ; map + (next {}) nil + (next (sorted-map :a 1)) nil + (next (sorted-map :a 1 :b 2 :c 3)) '((:b 2) (:c 3)) + + ; array + (next (into-array [])) nil + (next (into-array [1])) nil + (next (into-array [1 2 3])) '(2 3) + + (next (to-array [nil])) nil + (next (to-array [1 nil])) '(nil) + ;(next (to-array [1 (into-array [])])) (list (into-array [])) + (next (to-array [nil 2])) '(2) + (next (to-array [(into-array [])])) nil + (next (to-array [(into-array []) nil])) '(nil) + (next (to-array [(into-array []) 2 nil])) '(2 nil) )) + + +(deftest test-last + (are [x y] (= x y) + (last nil) nil + + ; list + (last ()) nil + (last '(1)) 1 + (last '(1 2 3)) 3 + + (last '(nil)) nil + (last '(1 nil)) nil + (last '(nil 2)) 2 + (last '(())) () + (last '(() nil)) nil + (last '(() 2 nil)) nil + + ; vector + (last []) nil + (last [1]) 1 + (last [1 2 3]) 3 + + (last [nil]) nil + (last [1 nil]) nil + (last [nil 2]) 2 + (last [[]]) [] + (last [[] nil]) nil + (last [[] 2 nil]) nil + + ; set + (last #{}) nil + (last #{1}) 1 + (last (sorted-set 1 2 3)) 3 + + (last #{nil}) nil + (last (sorted-set 1 nil)) 1 + (last (sorted-set nil 2)) 2 + (last #{#{}}) #{} + (last (sorted-set #{} nil)) #{} + ;(last (sorted-set #{} 2 nil)) nil + + ; map + (last {}) nil + (last (sorted-map :a 1)) [:a 1] + (last (sorted-map :a 1 :b 2 :c 3)) [:c 3] + + ; string + (last "") nil + (last "a") \a + (last "abc") \c + + ; array + (last (into-array [])) nil + (last (into-array [1])) 1 + (last (into-array [1 2 3])) 3 + (last (to-array [nil])) nil + (last (to-array [1 nil])) nil + (last (to-array [nil 2])) 2 )) + + +;; (ffirst coll) = (first (first coll)) +;; +(deftest test-ffirst + (is (thrown? IllegalArgumentException (ffirst))) + (are [x y] (= x y) + (ffirst nil) nil + + (ffirst ()) nil + (ffirst '((1 2) (3 4))) 1 + + (ffirst []) nil + (ffirst [[1 2] [3 4]]) 1 + + (ffirst {}) nil + (ffirst {:a 1}) :a + + (ffirst #{}) nil + (ffirst #{[1 2]}) 1 )) + + +;; (fnext coll) = (first (next coll)) = (second coll) +;; +(deftest test-fnext + (is (thrown? IllegalArgumentException (fnext))) + (are [x y] (= x y) + (fnext nil) nil + + (fnext ()) nil + (fnext '(1)) nil + (fnext '(1 2 3 4)) 2 + + (fnext []) nil + (fnext [1]) nil + (fnext [1 2 3 4]) 2 + + (fnext {}) nil + (fnext (sorted-map :a 1)) nil + (fnext (sorted-map :a 1 :b 2)) [:b 2] + + (fnext #{}) nil + (fnext #{1}) nil + (fnext (sorted-set 1 2 3 4)) 2 )) + + +;; (nfirst coll) = (next (first coll)) +;; +(deftest test-nfirst + (is (thrown? IllegalArgumentException (nfirst))) + (are [x y] (= x y) + (nfirst nil) nil + + (nfirst ()) nil + (nfirst '((1 2 3) (4 5 6))) '(2 3) + + (nfirst []) nil + (nfirst [[1 2 3] [4 5 6]]) '(2 3) + + (nfirst {}) nil + (nfirst {:a 1}) '(1) + + (nfirst #{}) nil + (nfirst #{[1 2]}) '(2) )) + + +;; (nnext coll) = (next (next coll)) +;; +(deftest test-nnext + (is (thrown? IllegalArgumentException (nnext))) + (are [x y] (= x y) + (nnext nil) nil + + (nnext ()) nil + (nnext '(1)) nil + (nnext '(1 2)) nil + (nnext '(1 2 3 4)) '(3 4) + + (nnext []) nil + (nnext [1]) nil + (nnext [1 2]) nil + (nnext [1 2 3 4]) '(3 4) + + (nnext {}) nil + (nnext (sorted-map :a 1)) nil + (nnext (sorted-map :a 1 :b 2)) nil + (nnext (sorted-map :a 1 :b 2 :c 3 :d 4)) '([:c 3] [:d 4]) + + (nnext #{}) nil + (nnext #{1}) nil + (nnext (sorted-set 1 2)) nil + (nnext (sorted-set 1 2 3 4)) '(3 4) )) + + +(deftest test-nth + ; maps, sets are not supported + (is (thrown? UnsupportedOperationException (nth {} 0))) + (is (thrown? UnsupportedOperationException (nth {:a 1 :b 2} 0))) + (is (thrown? UnsupportedOperationException (nth #{} 0))) + (is (thrown? UnsupportedOperationException (nth #{1 2 3} 0))) + + ; out of bounds + (is (thrown? IndexOutOfBoundsException (nth '() 0))) + (is (thrown? IndexOutOfBoundsException (nth '(1 2 3) 5))) + (is (thrown? IndexOutOfBoundsException (nth '() -1))) + (is (thrown? IndexOutOfBoundsException (nth '(1 2 3) -1))) + + (is (thrown? IndexOutOfBoundsException (nth [] 0))) + (is (thrown? IndexOutOfBoundsException (nth [1 2 3] 5))) + (is (thrown? IndexOutOfBoundsException (nth [] -1))) + (is (thrown? ArrayIndexOutOfBoundsException (nth [1 2 3] -1))) ; ??? + + (is (thrown? ArrayIndexOutOfBoundsException (nth (into-array []) 0))) + (is (thrown? ArrayIndexOutOfBoundsException (nth (into-array [1 2 3]) 5))) + (is (thrown? ArrayIndexOutOfBoundsException (nth (into-array []) -1))) + (is (thrown? ArrayIndexOutOfBoundsException (nth (into-array [1 2 3]) -1))) + + (is (thrown? StringIndexOutOfBoundsException (nth "" 0))) + (is (thrown? StringIndexOutOfBoundsException (nth "abc" 5))) + (is (thrown? StringIndexOutOfBoundsException (nth "" -1))) + (is (thrown? StringIndexOutOfBoundsException (nth "abc" -1))) + + (is (thrown? IndexOutOfBoundsException (nth (java.util.ArrayList. []) 0))) + (is (thrown? IndexOutOfBoundsException (nth (java.util.ArrayList. [1 2 3]) 5))) + (is (thrown? ArrayIndexOutOfBoundsException (nth (java.util.ArrayList. []) -1))) ; ??? + (is (thrown? ArrayIndexOutOfBoundsException (nth (java.util.ArrayList. [1 2 3]) -1))) ; ??? + + (are [x y] (= x y) + (nth '(1) 0) 1 + (nth '(1 2 3) 0) 1 + (nth '(1 2 3 4 5) 1) 2 + (nth '(1 2 3 4 5) 4) 5 + (nth '(1 2 3) 5 :not-found) :not-found + + (nth [1] 0) 1 + (nth [1 2 3] 0) 1 + (nth [1 2 3 4 5] 1) 2 + (nth [1 2 3 4 5] 4) 5 + (nth [1 2 3] 5 :not-found) :not-found + + (nth (into-array [1]) 0) 1 + (nth (into-array [1 2 3]) 0) 1 + (nth (into-array [1 2 3 4 5]) 1) 2 + (nth (into-array [1 2 3 4 5]) 4) 5 + (nth (into-array [1 2 3]) 5 :not-found) :not-found + + (nth "a" 0) \a + (nth "abc" 0) \a + (nth "abcde" 1) \b + (nth "abcde" 4) \e + (nth "abc" 5 :not-found) :not-found + + (nth (java.util.ArrayList. [1]) 0) 1 + (nth (java.util.ArrayList. [1 2 3]) 0) 1 + (nth (java.util.ArrayList. [1 2 3 4 5]) 1) 2 + (nth (java.util.ArrayList. [1 2 3 4 5]) 4) 5 + (nth (java.util.ArrayList. [1 2 3]) 5 :not-found) :not-found ) + + ; regex Matchers + (let [m (re-matcher #"(a)(b)" "ababaa")] + (re-find m) ; => ["ab" "a" "b"] + (are [x y] (= x y) + (nth m 0) "ab" + (nth m 1) "a" + (nth m 2) "b" + (nth m 3 :not-found) :not-found + (nth m -1 :not-found) :not-found ) + (is (thrown? IndexOutOfBoundsException (nth m 3))) + (is (thrown? IndexOutOfBoundsException (nth m -1)))) + + (let [m (re-matcher #"c" "ababaa")] + (re-find m) ; => nil + (are [x y] (= x y) + (nth m 0 :not-found) :not-found + (nth m 2 :not-found) :not-found + (nth m -1 :not-found) :not-found ) + (is (thrown? IllegalStateException (nth m 0))) + (is (thrown? IllegalStateException (nth m 2))) + (is (thrown? IllegalStateException (nth m -1))))) + + +; distinct was broken for nil & false: +; fixed in rev 1278: +; http://code.google.com/p/clojure/source/detail?r=1278 +; +(deftest test-distinct + (are [x y] (= x y) + (distinct ()) () + (distinct '(1)) '(1) + (distinct '(1 2 3)) '(1 2 3) + (distinct '(1 2 3 1 1 1)) '(1 2 3) + (distinct '(1 1 1 2)) '(1 2) + (distinct '(1 2 1 2)) '(1 2) + + (distinct []) () + (distinct [1]) '(1) + (distinct [1 2 3]) '(1 2 3) + (distinct [1 2 3 1 2 2 1 1]) '(1 2 3) + (distinct [1 1 1 2]) '(1 2) + (distinct [1 2 1 2]) '(1 2) + + (distinct "") () + (distinct "a") '(\a) + (distinct "abc") '(\a \b \c) + (distinct "abcabab") '(\a \b \c) + (distinct "aaab") '(\a \b) + (distinct "abab") '(\a \b) ) + + (are [x] (= (distinct [x x]) [x]) + nil + false true + 0 42 + 0.0 3.14 + 2/3 + 0M 1M + \c + "" "abc" + 'sym + :kw + () '(1 2) + [] [1 2] + {} {:a 1 :b 2} + #{} #{1 2} )) + + +(deftest test-interpose + (are [x y] (= x y) + (interpose 0 []) () + (interpose 0 [1]) '(1) + (interpose 0 [1 2]) '(1 0 2) + (interpose 0 [1 2 3]) '(1 0 2 0 3) )) + + +(deftest test-interleave + (are [x y] (= x y) + (interleave [1 2] [3 4]) '(1 3 2 4) + + (interleave [1] [3 4]) '(1 3) + (interleave [1 2] [3]) '(1 3) + + (interleave [] [3 4]) () + (interleave [1 2] []) () + (interleave [] []) () )) + + +(deftest test-zipmap + (are [x y] (= x y) + (zipmap [:a :b] [1 2]) {:a 1 :b 2} + + (zipmap [:a] [1 2]) {:a 1} + (zipmap [:a :b] [1]) {:a 1} + + (zipmap [] [1 2]) {} + (zipmap [:a :b] []) {} + (zipmap [] []) {} )) + + +(deftest test-concat + (are [x y] (= x y) + (concat) () + + (concat []) () + (concat [1 2]) '(1 2) + + (concat [1 2] [3 4]) '(1 2 3 4) + (concat [] [3 4]) '(3 4) + (concat [1 2] []) '(1 2) + (concat [] []) () + + (concat [1 2] [3 4] [5 6]) '(1 2 3 4 5 6) )) + + +(deftest test-cycle + (are [x y] (= x y) + (cycle []) () + + (take 3 (cycle [1])) '(1 1 1) + (take 5 (cycle [1 2 3])) '(1 2 3 1 2) + + (take 3 (cycle [nil])) '(nil nil nil) )) + + +(deftest test-partition + (are [x y] (= x y) + (partition 2 [1 2 3]) '((1 2)) + (partition 2 [1 2 3 4]) '((1 2) (3 4)) + (partition 2 []) () + + (partition 2 3 [1 2 3 4 5 6 7]) '((1 2) (4 5)) + (partition 2 3 [1 2 3 4 5 6 7 8]) '((1 2) (4 5) (7 8)) + (partition 2 3 []) () + + (partition 1 []) () + (partition 1 [1 2 3]) '((1) (2) (3)) + + (partition 5 [1 2 3]) () + +; (partition 0 [1 2 3]) (repeat nil) ; infinite sequence of nil + (partition -1 [1 2 3]) () + (partition -2 [1 2 3]) () )) + + +(deftest test-reverse + (are [x y] (= x y) + (reverse nil) () ; since SVN 1294 + (reverse []) () + (reverse [1]) '(1) + (reverse [1 2 3]) '(3 2 1) )) + + +(deftest test-take + (are [x y] (= x y) + (take 1 [1 2 3 4 5]) '(1) + (take 3 [1 2 3 4 5]) '(1 2 3) + (take 5 [1 2 3 4 5]) '(1 2 3 4 5) + (take 9 [1 2 3 4 5]) '(1 2 3 4 5) + + (take 0 [1 2 3 4 5]) () + (take -1 [1 2 3 4 5]) () + (take -2 [1 2 3 4 5]) () )) + + +(deftest test-drop + (are [x y] (= x y) + (drop 1 [1 2 3 4 5]) '(2 3 4 5) + (drop 3 [1 2 3 4 5]) '(4 5) + (drop 5 [1 2 3 4 5]) () + (drop 9 [1 2 3 4 5]) () + + (drop 0 [1 2 3 4 5]) '(1 2 3 4 5) + (drop -1 [1 2 3 4 5]) '(1 2 3 4 5) + (drop -2 [1 2 3 4 5]) '(1 2 3 4 5) )) + + +(deftest test-take-nth + (are [x y] (= x y) + (take-nth 1 [1 2 3 4 5]) '(1 2 3 4 5) + (take-nth 2 [1 2 3 4 5]) '(1 3 5) + (take-nth 3 [1 2 3 4 5]) '(1 4) + (take-nth 4 [1 2 3 4 5]) '(1 5) + (take-nth 5 [1 2 3 4 5]) '(1) + (take-nth 9 [1 2 3 4 5]) '(1) + + ; infinite seq of 1s = (repeat 1) + ;(take-nth 0 [1 2 3 4 5]) + ;(take-nth -1 [1 2 3 4 5]) + ;(take-nth -2 [1 2 3 4 5]) + )) + + +(deftest test-take-while + (are [x y] (= x y) + (take-while pos? []) () + (take-while pos? [1 2 3 4]) '(1 2 3 4) + (take-while pos? [1 2 3 -1]) '(1 2 3) + (take-while pos? [1 -1 2 3]) '(1) + (take-while pos? [-1 1 2 3]) () + (take-while pos? [-1 -2 -3]) () )) + + +(deftest test-drop-while + (are [x y] (= x y) + (drop-while pos? []) () + (drop-while pos? [1 2 3 4]) () + (drop-while pos? [1 2 3 -1]) '(-1) + (drop-while pos? [1 -1 2 3]) '(-1 2 3) + (drop-while pos? [-1 1 2 3]) '(-1 1 2 3) + (drop-while pos? [-1 -2 -3]) '(-1 -2 -3) )) + + +(deftest test-butlast + (are [x y] (= x y) + (butlast []) nil + (butlast [1]) nil + (butlast [1 2 3]) '(1 2) )) + + +(deftest test-drop-last + (are [x y] (= x y) + ; as butlast + (drop-last []) () + (drop-last [1]) () + (drop-last [1 2 3]) '(1 2) + + ; as butlast, but lazy + (drop-last 1 []) () + (drop-last 1 [1]) () + (drop-last 1 [1 2 3]) '(1 2) + + (drop-last 2 []) () + (drop-last 2 [1]) () + (drop-last 2 [1 2 3]) '(1) + + (drop-last 5 []) () + (drop-last 5 [1]) () + (drop-last 5 [1 2 3]) () + + (drop-last 0 []) () + (drop-last 0 [1]) '(1) + (drop-last 0 [1 2 3]) '(1 2 3) + + (drop-last -1 []) () + (drop-last -1 [1]) '(1) + (drop-last -1 [1 2 3]) '(1 2 3) + + (drop-last -2 []) () + (drop-last -2 [1]) '(1) + (drop-last -2 [1 2 3]) '(1 2 3) )) + + +(deftest test-split-at + (is (vector? (split-at 2 []))) + (is (vector? (split-at 2 [1 2 3]))) + + (are [x y] (= x y) + (split-at 2 []) [() ()] + (split-at 2 [1 2 3 4 5]) [(list 1 2) (list 3 4 5)] + + (split-at 5 [1 2 3]) [(list 1 2 3) ()] + (split-at 0 [1 2 3]) [() (list 1 2 3)] + (split-at -1 [1 2 3]) [() (list 1 2 3)] + (split-at -5 [1 2 3]) [() (list 1 2 3)] )) + + +(deftest test-split-with + (is (vector? (split-with pos? []))) + (is (vector? (split-with pos? [1 2 -1 0 3 4]))) + + (are [x y] (= x y) + (split-with pos? []) [() ()] + (split-with pos? [1 2 -1 0 3 4]) [(list 1 2) (list -1 0 3 4)] + + (split-with pos? [-1 2 3 4 5]) [() (list -1 2 3 4 5)] + (split-with number? [1 -2 "abc" \x]) [(list 1 -2) (list "abc" \x)] )) + + +(deftest test-repeat + (is (thrown? IllegalArgumentException (repeat))) + + ; infinite sequence => use take + (are [x y] (= x y) + (take 0 (repeat 7)) () + (take 1 (repeat 7)) '(7) + (take 2 (repeat 7)) '(7 7) + (take 5 (repeat 7)) '(7 7 7 7 7) ) + + ; limited sequence + (are [x y] (= x y) + (repeat 0 7) () + (repeat 1 7) '(7) + (repeat 2 7) '(7 7) + (repeat 5 7) '(7 7 7 7 7) + + (repeat -1 7) () + (repeat -3 7) () ) + + ; test different data types + (are [x] (= (repeat 3 x) (list x x x)) + nil + false true + 0 42 + 0.0 3.14 + 2/3 + 0M 1M + \c + "" "abc" + 'sym + :kw + () '(1 2) + [] [1 2] + {} {:a 1 :b 2} + #{} #{1 2} )) + + +(deftest test-range + (are [x y] (= x y) + (range 0) () ; exclusive end! + (range 1) '(0) + (range 5) '(0 1 2 3 4) + + (range -1) () + (range -3) () + + (range 2.5) '(0 1) + (range 7/3) '(0 1) + + (range 0 3) '(0 1 2) + (range 0 1) '(0) + (range 0 0) () + (range 0 -3) () + + (range 3 6) '(3 4 5) + (range 3 4) '(3) + (range 3 3) () + (range 3 1) () + (range 3 0) () + (range 3 -2) () + + (range -2 5) '(-2 -1 0 1 2 3 4) + (range -2 0) '(-2 -1) + (range -2 -1) '(-2) + (range -2 -2) () + (range -2 -5) () + + (range 3 9 0) () + (range 3 9 1) '(3 4 5 6 7 8) + (range 3 9 2) '(3 5 7) + (range 3 9 3) '(3 6) + (range 3 9 10) '(3) + (range 3 9 -1) () )) + + +(deftest test-empty? + (are [x] (empty? x) + nil + () + (lazy-seq nil) ; => () + [] + {} + #{} + "" + (into-array []) ) + + (are [x] (not (empty? x)) + '(1 2) + (lazy-seq [1 2]) + [1 2] + {:a 1 :b 2} + #{1 2} + "abc" + (into-array [1 2]) )) + + +(deftest test-every? + ; always true for nil or empty coll/seq + (are [x] (= (every? pos? x) true) + nil + () [] {} #{} + (lazy-seq []) + (into-array []) ) + + (are [x y] (= x y) + true (every? pos? [1]) + true (every? pos? [1 2]) + true (every? pos? [1 2 3 4 5]) + + false (every? pos? [-1]) + false (every? pos? [-1 -2]) + false (every? pos? [-1 -2 3]) + false (every? pos? [-1 2]) + false (every? pos? [1 -2]) + false (every? pos? [1 2 -3]) + false (every? pos? [1 2 -3 4]) ) + + (are [x y] (= x y) + true (every? #{:a} [:a :a]) +;! false (every? #{:a} [:a :b]) ; Issue 68: every? returns nil instead of false +;! false (every? #{:a} [:b :b]) ; http://code.google.com/p/clojure/issues/detail?id=68 + )) + + +(deftest test-not-every? + ; always false for nil or empty coll/seq + (are [x] (= (not-every? pos? x) false) + nil + () [] {} #{} + (lazy-seq []) + (into-array []) ) + + (are [x y] (= x y) + false (not-every? pos? [1]) + false (not-every? pos? [1 2]) + false (not-every? pos? [1 2 3 4 5]) + + true (not-every? pos? [-1]) + true (not-every? pos? [-1 -2]) + true (not-every? pos? [-1 -2 3]) + true (not-every? pos? [-1 2]) + true (not-every? pos? [1 -2]) + true (not-every? pos? [1 2 -3]) + true (not-every? pos? [1 2 -3 4]) ) + + (are [x y] (= x y) + false (not-every? #{:a} [:a :a]) + true (not-every? #{:a} [:a :b]) + true (not-every? #{:a} [:b :b]) )) + + +(deftest test-not-any? + ; always true for nil or empty coll/seq + (are [x] (= (not-any? pos? x) true) + nil + () [] {} #{} + (lazy-seq []) + (into-array []) ) + + (are [x y] (= x y) + false (not-any? pos? [1]) + false (not-any? pos? [1 2]) + false (not-any? pos? [1 2 3 4 5]) + + true (not-any? pos? [-1]) + true (not-any? pos? [-1 -2]) + + false (not-any? pos? [-1 -2 3]) + false (not-any? pos? [-1 2]) + false (not-any? pos? [1 -2]) + false (not-any? pos? [1 2 -3]) + false (not-any? pos? [1 2 -3 4]) ) + + (are [x y] (= x y) + false (not-any? #{:a} [:a :a]) + false (not-any? #{:a} [:a :b]) + true (not-any? #{:a} [:b :b]) )) + + +; TODO: some + diff --git a/test/clojure/test_clojure/special.clj b/test/clojure/test_clojure/special.clj new file mode 100644 index 00000000..f3a8164c --- /dev/null +++ b/test/clojure/test_clojure/special.clj @@ -0,0 +1,24 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +; Author: Frantisek Sodomka + +;; +;; Test special forms, macros and metadata +;; + +(ns clojure.test-clojure.special + (:use clojure.test)) + +; http://clojure.org/special_forms + +; let, letfn +; quote +; var +; fn + diff --git a/test/clojure/test_clojure/test.clj b/test/clojure/test_clojure/test.clj new file mode 100644 index 00000000..38cf802f --- /dev/null +++ b/test/clojure/test_clojure/test.clj @@ -0,0 +1,113 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +;;; test_contrib/test_is.clj: unit tests for test_is.clj + +;; by Stuart Sierra +;; January 16, 2009 + +;; Thanks to Chas Emerick, Allen Rohner, and Stuart Halloway for +;; contributions and suggestions. + + +(ns clojure.test-clojure.test + (:use clojure.test)) + +(deftest can-test-symbol + (let [x true] + (is x "Should pass")) + (let [x false] + (is x "Should fail"))) + +(deftest can-test-boolean + (is true "Should pass") + (is false "Should fail")) + +(deftest can-test-nil + (is nil "Should fail")) + +(deftest can-test-= + (is (= 2 (+ 1 1)) "Should pass") + (is (= 3 (+ 2 2)) "Should fail")) + +(deftest can-test-instance + (is (instance? Integer (+ 2 2)) "Should pass") + (is (instance? Float (+ 1 1)) "Should fail")) + +(deftest can-test-thrown + (is (thrown? ArithmeticException (/ 1 0)) "Should pass") + ;; No exception is thrown: + (is (thrown? Exception (+ 1 1)) "Should fail") + ;; Wrong class of exception is thrown: + (is (thrown? ArithmeticException (throw (RuntimeException.))) "Should error")) + +(deftest can-test-thrown-with-msg + (is (thrown-with-msg? ArithmeticException #"Divide by zero" (/ 1 0)) "Should pass") + ;; Wrong message string: + (is (thrown-with-msg? ArithmeticException #"Something else" (/ 1 0)) "Should fail") + ;; No exception is thrown: + (is (thrown? Exception (+ 1 1)) "Should fail") + ;; Wrong class of exception is thrown: + (is (thrown-with-msg? IllegalArgumentException #"Divide by zero" (/ 1 0)) "Should error")) + +(deftest can-catch-unexpected-exceptions + (is (= 1 (throw (Exception.))) "Should error")) + +(deftest can-test-method-call + (is (.startsWith "abc" "a") "Should pass") + (is (.startsWith "abc" "d") "Should fail")) + +(deftest can-test-anonymous-fn + (is (#(.startsWith % "a") "abc") "Should pass") + (is (#(.startsWith % "d") "abc") "Should fail")) + +(deftest can-test-regexps + (is (re-matches #"^ab.*$" "abbabba") "Should pass") + (is (re-matches #"^cd.*$" "abbabba") "Should fail") + (is (re-find #"ab" "abbabba") "Should pass") + (is (re-find #"cd" "abbabba") "Should fail")) + + +;; still have to declare the symbol before testing unbound symbols +(declare does-not-exist) + +(deftest can-test-unbound-symbol + (is (= nil does-not-exist) "Should error")) + +(deftest can-test-unbound-function + (is (does-not-exist) "Should error")) + + +;; Here, we create an alternate version of test-is/report, that +;; compares the event with the message, then calls the original +;; 'report' with modified arguments. + +(declare original-report) + +(defn custom-report [data] + (let [event (:type data) + msg (:message data) + expected (:expected data) + actual (:actual data) + passed (cond + (= event :fail) (= msg "Should fail") + (= event :pass) (= msg "Should pass") + (= event :error) (= msg "Should error") + :else true)] + (if passed + (original-report {:type :pass, :message msg, + :expected expected, :actual actual}) + (original-report {:type :fail, :message (str msg " but got " event) + :expected expected, :actual actual})))) + +;; test-ns-hook will be used by test-is/test-ns to run tests in this +;; namespace. +(defn test-ns-hook [] + (binding [original-report report + report custom-report] + (test-all-vars (find-ns 'clojure.test-clojure.test)))) diff --git a/test/clojure/test_clojure/test_fixtures.clj b/test/clojure/test_clojure/test_fixtures.clj new file mode 100644 index 00000000..707dcc38 --- /dev/null +++ b/test/clojure/test_clojure/test_fixtures.clj @@ -0,0 +1,41 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. +; +;;; test_is_fixtures.clj: unit tests for fixtures in test_is.clj + +;; by Stuart Sierra +;; March 28, 2009 + +(ns clojure.test-clojure.test-fixtures + (:use clojure.test)) + +(declare *a* *b* *c* *d*) + +(defn fixture-a [f] + (binding [*a* 3] (f))) + +(defn fixture-b [f] + (binding [*b* 5] (f))) + +(defn fixture-c [f] + (binding [*c* 7] (f))) + +(defn fixture-d [f] + (binding [*d* 11] (f))) + +(use-fixtures :once fixture-a fixture-b) + +(use-fixtures :each fixture-c fixture-d) + +(deftest can-use-once-fixtures + (is (= 3 *a*)) + (is (= 5 *b*))) + +(deftest can-use-each-fixtures + (is (= 7 *c*)) + (is (= 11 *d*))) diff --git a/test/clojure/test_clojure/test_utils.clj b/test/clojure/test_clojure/test_utils.clj new file mode 100644 index 00000000..d1905100 --- /dev/null +++ b/test/clojure/test_clojure/test_utils.clj @@ -0,0 +1,33 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +; Author: Frantisek Sodomka + + +(ns clojure.test-clojure.test-utils) + + (defn exception + "Use this function to ensure that execution of a program doesn't + reach certain point." + [] + (throw (new Exception "Exception which should never occur"))) + + +;; (defmacro all-are +;; "Test all-with-all. +;; (all-are (= _1 _2) +;; a b c) +;; => +;; (do +;; (is (= a b)) +;; (is (= a c)) +;; (is (= b c)))" +;; [expr & args] +;; (concat +;; (list 'clojure.contrib.template/do-template (list 'clojure.test/is expr)) +;; (apply concat (combinations args 2))))) diff --git a/test/clojure/test_clojure/vars.clj b/test/clojure/test_clojure/vars.clj new file mode 100644 index 00000000..cbdc72d9 --- /dev/null +++ b/test/clojure/test_clojure/vars.clj @@ -0,0 +1,56 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. +; By using this software in any fashion, you are agreeing to be bound by +; the terms of this license. +; You must not remove this notice, or any other, from this software. + +; Author: Frantisek Sodomka + + +(ns clojure.test-clojure.vars + (:use clojure.test)) + +; http://clojure.org/vars + +; def +; defn defn- defonce + +; declare intern binding find-var var + +(def a) +(deftest test-binding + (are [_1 _2] (= _1 _2) + (eval `(binding [a 4] a)) 4 ; regression in Clojure SVN r1370 + )) + +; with-local-vars var-get var-set alter-var-root [var? (predicates.clj)] +; with-in-str with-out-str +; with-open +; with-precision + +(deftest test-with-precision + (are [x y] (= x y) + (with-precision 4 (+ 3.5555555M 1)) 4.556M + (with-precision 6 (+ 3.5555555M 1)) 4.55556M + (with-precision 6 :rounding CEILING (+ 3.5555555M 1)) 4.55556M + (with-precision 6 :rounding FLOOR (+ 3.5555555M 1)) 4.55555M + (with-precision 6 :rounding HALF_UP (+ 3.5555555M 1)) 4.55556M + (with-precision 6 :rounding HALF_DOWN (+ 3.5555555M 1)) 4.55556M + (with-precision 6 :rounding HALF_EVEN (+ 3.5555555M 1)) 4.55556M + (with-precision 6 :rounding UP (+ 3.5555555M 1)) 4.55556M + (with-precision 6 :rounding DOWN (+ 3.5555555M 1)) 4.55555M + (with-precision 6 :rounding UNNECESSARY (+ 3.5555M 1)) 4.5555M)) + +(deftest test-settable-math-context + (is (= + (clojure.main/with-bindings + (set! *math-context* (java.math.MathContext. 8)) + (+ 3.55555555555555M 1)) + 4.5555556M))) + +; set-validator get-validator + +; doc find-doc test + |