diff options
| author | Stuart Halloway <stu@thinkrelevance.com> | 2009-06-25 22:19:00 -0400 |
|---|---|---|
| committer | Stuart Halloway <stu@thinkrelevance.com> | 2009-06-25 22:19:00 -0400 |
| commit | 82cf0409d0fcb71be477ebfc4da18ee2128a2ad1 (patch) | |
| tree | d150d6e182e693bffb735604c473b7f7dc051fed | |
| parent | f9b111c67752220c9d45a7d6ef22c6eecf400c87 (diff) | |
| parent | 4f2c7bb5cf6828eb710fd18b603828ab295d0fa5 (diff) | |
Merge commit 'stuart/gtic'
72 files changed, 85 insertions, 5967 deletions
@@ -31,20 +31,6 @@ <delete dir="${build}"/> </target> - <target name="test_clojure" - description="Run clojure tests" - if="hasclojure"> - <java classname="clojure.main"> - <classpath> - <path location="${build}"/> - <path location="${src}"/> - <path location="${clojure.jar}"/> - </classpath> - <arg value="-e"/> - <arg value="(require '(clojure.contrib [test-clojure :as main])) (main/run)"/> - </java> - </target> - <target name="test_contrib" description="Run contrib tests" if="hasclojure"> @@ -73,7 +59,7 @@ </java> </target> - <target name="test" depends="test_clojure,test_contrib,test_datalog" + <target name="test" depends="test_contrib,test_datalog" description="Run all tests"/> <target name="check_hasclojure" @@ -121,7 +107,6 @@ <arg value="clojure.contrib.complex-numbers"/> <arg value="clojure.contrib.cond"/> <arg value="clojure.contrib.condition"/> - <arg value="clojure.contrib.condt"/> <arg value="clojure.contrib.core"/> <arg value="clojure.contrib.dataflow"/> <arg value="clojure.contrib.datalog"/> @@ -182,16 +167,11 @@ <arg value="clojure.contrib.singleton"/> <arg value="clojure.contrib.sql"/> <arg value="clojure.contrib.sql.internal"/> - <arg value="clojure.contrib.stacktrace"/> <arg value="clojure.contrib.str-utils"/> <arg value="clojure.contrib.stream-utils"/> <arg value="clojure.contrib.swing-utils"/> - <arg value="clojure.contrib.template"/> - <arg value="clojure.contrib.test-is"/> - <arg value="clojure.contrib.test-is.tap"/> <arg value="clojure.contrib.trace"/> <arg value="clojure.contrib.types"/> - <arg value="clojure.contrib.walk"/> <arg value="clojure.contrib.with-ns"/> <arg value="clojure.contrib.zip-filter"/> <arg value="clojure.contrib.zip-filter.xml"/> diff --git a/src/clojure/contrib/condt.clj b/src/clojure/contrib/condt.clj deleted file mode 100644 index b5ac4da4..00000000 --- a/src/clojure/contrib/condt.clj +++ /dev/null @@ -1,62 +0,0 @@ -;;; condt.clj - generic case-like macro using template expressions - -;; By Stuart Sierra, http://stuartsierra.com/ -;; February 21, 2009 - -;; Copyright (c) Stuart Sierra, 2008. 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. - - -;; CHANGE LOG -;; -;; February 21, 2009: fixed to work with new lazy Clojure -;; -;; December 23, 2008: renamed to condt, since clojure.core now -;; contains a (different) condp as of Clojure SVN rev. 1180 -;; -;; December 15, 2008: original version, named "condp" - - -(ns - #^{:author "Stuart Sierra" - :doc "Generic case-like macro using template expressions"} - clojure.contrib.condt - (:require clojure.contrib.template)) - -(defmacro condt - "expr is a template expression (see template), clauses are test/expr - pairs like cond. Evalautes the template on each test value, one at - a time. If a test returns logical true, condt evaluates the - corresponding expr and returns its value. If none of the tests are - true, and there are an odd number of clauses, the last clause is - evaluated, otherwise returns nil." - [expr & clauses] - (let [test-fn-sym (gensym "test_") - f (fn this [c] - (cond - (empty? c) nil - (= 1 (count c)) (first c) - :else (list 'if (list test-fn-sym (first c)) - (second c) - (this (nthnext c 2)))))] - `(let [~test-fn-sym (clojure.contrib.template/template ~expr)] - ~(f clauses)))) - -(defmacro econdt - "Like condt but throws Exception if no tests match." - [expr & clauses] - (let [test-fn-sym (gensym "test_") - f (fn this [c] - (cond - (empty? c) '(throw (Exception. "Nothing matched in econdt.")) - (= 1 (count c)) (throw (IllegalStateException. "Odd number of clauses in econdt.")) - :else (list 'if (list test-fn-sym (first c)) - (second c) - (this (nthnext c 2)))))] - `(let [~test-fn-sym (clojure.contrib.template/template ~expr)] - ~(f clauses)))) diff --git a/src/clojure/contrib/core/tests.clj b/src/clojure/contrib/core/tests.clj index ddc79dc7..d2e0d50d 100644 --- a/src/clojure/contrib/core/tests.clj +++ b/src/clojure/contrib/core/tests.clj @@ -13,7 +13,7 @@ ;; note to other contrib members: feel free to add to this lib (ns clojure.contrib.core.tests - (:use clojure.contrib.test-is) + (:use clojure.test) (:use clojure.contrib.core)) (deftest test-classic-versions diff --git a/src/clojure/contrib/dataflow.clj b/src/clojure/contrib/dataflow.clj index b23a7231..894942be 100644 --- a/src/clojure/contrib/dataflow.clj +++ b/src/clojure/contrib/dataflow.clj @@ -23,7 +23,7 @@ reverse-graph dependency-list get-neighbors)]) - (:use [clojure.contrib.walk :only (postwalk)]) + (:use [clojure.walk :only (postwalk)]) (:use [clojure.contrib.except :only (throwf)])) @@ -500,7 +500,7 @@ (get-value df 'greg) (use :reload 'clojure.contrib.dataflow) - (use 'clojure.contrib.stacktrace) (e) + (use 'clojure.stacktrace) (e) (use 'clojure.contrib.trace) ) diff --git a/src/clojure/contrib/datalog/tests/test.clj b/src/clojure/contrib/datalog/tests/test.clj index c649e6b2..121d264e 100644 --- a/src/clojure/contrib/datalog/tests/test.clj +++ b/src/clojure/contrib/datalog/tests/test.clj @@ -14,7 +14,7 @@ ;; Created 11 Feburary 2009 (ns clojure.contrib.datalog.tests.test - (:use [clojure.contrib.test-is :only (run-tests)]) + (:use [clojure.test :only (run-tests)]) (:gen-class)) (def test-names [:test-util diff --git a/src/clojure/contrib/datalog/tests/test_database.clj b/src/clojure/contrib/datalog/tests/test_database.clj index 1aaea324..06649611 100644 --- a/src/clojure/contrib/datalog/tests/test_database.clj +++ b/src/clojure/contrib/datalog/tests/test_database.clj @@ -15,7 +15,7 @@ (ns clojure.contrib.datalog.tests.test-database - (:use clojure.contrib.test-is + (:use clojure.test clojure.contrib.datalog.database)) diff --git a/src/clojure/contrib/datalog/tests/test_literals.clj b/src/clojure/contrib/datalog/tests/test_literals.clj index 107a4dc6..36ee5147 100644 --- a/src/clojure/contrib/datalog/tests/test_literals.clj +++ b/src/clojure/contrib/datalog/tests/test_literals.clj @@ -15,7 +15,7 @@ (ns clojure.contrib.datalog.tests.test-literals - (:use clojure.contrib.test-is) + (:use clojure.test) (:use clojure.contrib.datalog.literals clojure.contrib.datalog.database)) diff --git a/src/clojure/contrib/datalog/tests/test_magic.clj b/src/clojure/contrib/datalog/tests/test_magic.clj index b790475f..7eabae78 100644 --- a/src/clojure/contrib/datalog/tests/test_magic.clj +++ b/src/clojure/contrib/datalog/tests/test_magic.clj @@ -14,7 +14,7 @@ ;; Created 18 Feburary 2009 (ns clojure.contrib.datalog.tests.test-magic - (:use clojure.contrib.test-is) + (:use clojure.test) (:use clojure.contrib.datalog.magic clojure.contrib.datalog.rules)) diff --git a/src/clojure/contrib/datalog/tests/test_rules.clj b/src/clojure/contrib/datalog/tests/test_rules.clj index a42ad757..8b80b770 100644 --- a/src/clojure/contrib/datalog/tests/test_rules.clj +++ b/src/clojure/contrib/datalog/tests/test_rules.clj @@ -15,7 +15,7 @@ (ns clojure.contrib.datalog.tests.test-rules - (:use clojure.contrib.test-is + (:use clojure.test clojure.contrib.datalog.rules clojure.contrib.datalog.literals clojure.contrib.datalog.database)) diff --git a/src/clojure/contrib/datalog/tests/test_softstrat.clj b/src/clojure/contrib/datalog/tests/test_softstrat.clj index d17cef8b..a33d8c96 100644 --- a/src/clojure/contrib/datalog/tests/test_softstrat.clj +++ b/src/clojure/contrib/datalog/tests/test_softstrat.clj @@ -14,7 +14,7 @@ ;; Created 28 Feburary 2009 (ns clojure.contrib.datalog.tests.test-softstrat - (:use clojure.contrib.test-is) + (:use clojure.test) (:use clojure.contrib.datalog.softstrat clojure.contrib.datalog.magic clojure.contrib.datalog.rules diff --git a/src/clojure/contrib/datalog/tests/test_util.clj b/src/clojure/contrib/datalog/tests/test_util.clj index aac6ace9..9a5d0460 100644 --- a/src/clojure/contrib/datalog/tests/test_util.clj +++ b/src/clojure/contrib/datalog/tests/test_util.clj @@ -14,7 +14,7 @@ ;; Created 11 Feburary 2009 (ns clojure.contrib.datalog.tests.test-util - (:use clojure.contrib.test-is + (:use clojure.test clojure.contrib.datalog.util) (:use [clojure.contrib.except :only (throwf)])) diff --git a/src/clojure/contrib/error_kit.clj b/src/clojure/contrib/error_kit.clj index 0d5ea8e5..4db80d59 100644 --- a/src/clojure/contrib/error_kit.clj +++ b/src/clojure/contrib/error_kit.clj @@ -19,7 +19,7 @@ Please contact Chouser if you have any suggestions for better names or API adjustments."} clojure.contrib.error-kit (:use [clojure.contrib.def :only (defvar defvar-)] - [clojure.contrib.stacktrace :only (root-cause)])) + [clojure.stacktrace :only (root-cause)])) (defn- make-ctrl-exception [msg data] "Create an exception object with associated data, used for passing diff --git a/src/clojure/contrib/gen_html_docs.clj b/src/clojure/contrib/gen_html_docs.clj index 5b2b884d..8b043010 100644 --- a/src/clojure/contrib/gen_html_docs.clj +++ b/src/clojure/contrib/gen_html_docs.clj @@ -512,16 +512,11 @@ emits the generated HTML to the path named by path." 'clojure.contrib.server-socket 'clojure.contrib.shell-out 'clojure.contrib.sql - 'clojure.contrib.stacktrace 'clojure.contrib.stream-utils 'clojure.contrib.str-utils - 'clojure.contrib.template - 'clojure.contrib.test-clojure 'clojure.contrib.test-contrib - 'clojure.contrib.test-is 'clojure.contrib.trace 'clojure.contrib.types - 'clojure.contrib.walk 'clojure.contrib.zip-filter 'clojure.contrib.javadoc.browse 'clojure.contrib.json.read diff --git a/src/clojure/contrib/json/read.clj b/src/clojure/contrib/json/read.clj index 8070fc37..e9c7a3f2 100644 --- a/src/clojure/contrib/json/read.clj +++ b/src/clojure/contrib/json/read.clj @@ -48,7 +48,7 @@ :see-also [["http://www.json.org", "JSON Home Page"]]} clojure.contrib.json.read (:import (java.io PushbackReader StringReader EOFException)) - (:use [clojure.contrib.test-is :only (deftest- is)])) + (:use [clojure.test :only (deftest- is)])) (declare read-json) diff --git a/src/clojure/contrib/json/write.clj b/src/clojure/contrib/json/write.clj index 9db4a979..5f56f211 100644 --- a/src/clojure/contrib/json/write.clj +++ b/src/clojure/contrib/json/write.clj @@ -45,7 +45,7 @@ Within strings, all non-ASCII characters are hexadecimal escaped. :see-also [["http://json.org/", "JSON Home Page"]]} clojure.contrib.json.write (:require [clojure.contrib.java-utils :as j]) - (:use [clojure.contrib.test-is :only (deftest- is)])) + (:use [clojure.test :only (deftest- is)])) (defmulti #^{:doc "Prints x as JSON. Nil becomes JSON null. Keywords become @@ -145,9 +145,9 @@ Within strings, all non-ASCII characters are hexadecimal escaped. ;;; TESTS ;; Run these tests with -;; (clojure.contrib.test-is/run-tests 'clojure.contrib.print-json) +;; (clojure.test/run-tests 'clojure.contrib.print-json) -;; Bind clojure.contrib.test-is/*load-tests* to false to omit these +;; Bind clojure.test/*load-tests* to false to omit these ;; tests from production code. (deftest- can-print-json-strings diff --git a/src/clojure/contrib/load_all.clj b/src/clojure/contrib/load_all.clj index d72bd5d6..ff617a36 100644 --- a/src/clojure/contrib/load_all.clj +++ b/src/clojure/contrib/load_all.clj @@ -22,7 +22,7 @@ ;; errors, not that they work correctly. If the libraries have tests ;; defined using test-is, you can run them with: ;; -;; (clojure.contrib.test-is/run-all-tests) +;; (clojure.test/run-all-tests) ;; ;; If you write a new lib, please add it to the list in this file. diff --git a/src/clojure/contrib/macro_utils.clj b/src/clojure/contrib/macro_utils.clj index a243a5f9..08c743e1 100644 --- a/src/clojure/contrib/macro_utils.clj +++ b/src/clojure/contrib/macro_utils.clj @@ -27,7 +27,7 @@ macros can be used only inside a with-symbol-macros form."} clojure.contrib.macro-utils (:use [clojure.contrib.def :only (defvar-)]) - (:use [clojure.contrib.walk :only (prewalk)])) + (:use [clojure.walk :only (prewalk)])) ; A set of all special forms. Special forms are not macro-expanded, making ; it impossible to shadow them by macro definitions. For most special diff --git a/src/clojure/contrib/math/tests.clj b/src/clojure/contrib/math/tests.clj index 654a73f3..62816b3f 100644 --- a/src/clojure/contrib/math/tests.clj +++ b/src/clojure/contrib/math/tests.clj @@ -1,5 +1,5 @@ (ns clojure.contrib.math.tests
- (:use clojure.contrib.test-is
+ (:use clojure.test
clojure.contrib.math))
(deftest test-expt
diff --git a/src/clojure/contrib/pprint/examples/json.clj b/src/clojure/contrib/pprint/examples/json.clj index ca11231d..f62f81a7 100644 --- a/src/clojure/contrib/pprint/examples/json.clj +++ b/src/clojure/contrib/pprint/examples/json.clj @@ -20,7 +20,7 @@ This is an example of using a pretty printer dispatch function to generate JSON :see-also [["http://json.org/", "JSON Home Page"]]} clojure.contrib.pprint.examples.json (:require [clojure.contrib.java-utils :as j]) - (:use [clojure.contrib.test-is :only (deftest- is)] + (:use [clojure.test :only (deftest- is)] [clojure.contrib.pprint :only (write formatter-out)])) @@ -104,9 +104,9 @@ This is an example of using a pretty printer dispatch function to generate JSON ;;; TESTS ;; Run these tests with -;; (clojure.contrib.test-is/run-tests 'clojure.contrib.print-json) +;; (clojure.test/run-tests 'clojure.contrib.print-json) -;; Bind clojure.contrib.test-is/*load-tests* to false to omit these +;; Bind clojure.test/*load-tests* to false to omit these ;; tests from production code. (deftest- can-print-json-strings diff --git a/src/clojure/contrib/stacktrace.clj b/src/clojure/contrib/stacktrace.clj deleted file mode 100644 index 7330ef47..00000000 --- a/src/clojure/contrib/stacktrace.clj +++ /dev/null @@ -1,75 +0,0 @@ -;;; stacktrace.clj: print Clojure-centric stack traces - -;; by Stuart Sierra, http://stuartsierra.com/ -;; January 6, 2009 - -;; Copyright (c) Stuart Sierra, 2009. 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. - - -(ns - #^{:author "Stuart Sierra", - :doc "Print Clojure-centric stack traces"} - clojure.contrib.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/clojure/contrib/template.clj b/src/clojure/contrib/template.clj deleted file mode 100644 index f5049289..00000000 --- a/src/clojure/contrib/template.clj +++ /dev/null @@ -1,195 +0,0 @@ -;;; template.clj - anonymous functions that pre-evaluate sub-expressions - -;; By Stuart Sierra, http://stuartsierra.com/ -;; January 20, 2009 - -;; Copyright (c) Stuart Sierra, 2009. 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. - - - -;; CHANGE LOG -;; -;; January 20, 2009: added "template?" and checks for valid template -;; expressions. -;; -;; December 15, 2008: first version - - -;; DOCUMENTATION -;; -;; This file defines macros for using template expressions. These are -;; useful for writing macros. -;; -;; A template is an expression containing "holes" represented by the -;; symbols _1, _2, _3, and so on. ("_" is a synonym for "_1".) -;; -;; The "template" macro is similar to #(). It returns an anonymous -;; function containing the body of the template. Unlike #() or "fn", -;; however, any expressions that do not have any holes will be -;; evaluated only once, at the time the function is created, not every -;; time the function is called. -;; -;; Examples: -;; -(comment - ;; Assume we have some big, slow calculation. - (defn think-hard [] - (Thread/sleep 1000) - 1000) - - ;; With #(), think-hard gets called every time. - (time (doall (map #(+ % (think-hard)) - (range 5)))) - ;;=> "Elapsed time: 5001.33455 msecs" - ;;=> (1000 1001 1002 1003 1004) - - ;; With a template, think-hard only gets called once. - (time (doall (map (template (+ _ (think-hard))) - (range 5)))) - ;;=> "Elapsed time: 1000.907326 msecs" - ;;=> (1000 1001 1002 1003 1004) -) -;; -;; -;; There is also the do-template macro, which works differently. It -;; calls the same template multiple times, filling in values, and puts -;; it all inside a "do" block. It will split up the values based on -;; the number of holes in the template. -(comment - (do-template (foo _1 _2) :a :b :c :d) - ;; expands to: (do (foo :a :b) (foo :c :d)) - - (do-template (foo _1 _2 _3) 10 11 12 13 14 15) - ;; expands to: (foo 10 11 12) (foo 13 14 15) - ) - - - -(ns - #^{:author "Stuart Sierra", - :doc "Anonymous functions that pre-evaluate sub-expressions - - This file defines macros for using template expressions. These are - useful for writing macros. - - A template is an expression containing \"holes\" represented by the - symbols _1, _2, _3, and so on. (\"_\" is a synonym for \"_1\".) - - The \"template\" macro is similar to #(). It returns an anonymous - function containing the body of the template. Unlike #() or \"fn\", - however, any expressions that do not have any holes will be - evaluated only once, at the time the function is created, not every - time the function is called. - - Examples: - - Assume we have some big, slow calculation. - (defn think-hard [] - (Thread/sleep 1000) - 1000) - - With #(), think-hard gets called every time. - (time (doall (map #(+ % (think-hard)) - (range 5)))) - => \"Elapsed time: 5001.33455 msecs\" - => (1000 1001 1002 1003 1004) - - With a template, think-hard only gets called once. - (time (doall (map (template (+ _ (think-hard))) - (range 5)))) - => \"Elapsed time: 1000.907326 msecs\" - => (1000 1001 1002 1003 1004) - - There is also the do-template macro, which works differently. It - calls the same template multiple times, filling in values, and puts - it all inside a \"do\" block. It will split up the values based on - the number of holes in the template. - - (do-template (foo _1 _2) :a :b :c :d) - expands to: (do (foo :a :b) (foo :c :d)) - - (do-template (foo _1 _2 _3) 10 11 12 13 14 15) - expands to: (foo 10 11 12) (foo 13 14 15)"} - clojure.contrib.template - (:use clojure.contrib.walk)) - -(defn find-symbols - "Recursively finds all symbols in form." - [form] - (distinct (filter symbol? (tree-seq coll? seq form)))) - -(defn find-holes - "Recursively finds all symbols starting with _ in form." - [form] - (sort (distinct (filter #(.startsWith (name %) "_") - (find-symbols form))))) - -(defn find-pure-exprs - "Recursively finds all sub-expressions in form that do not contain - any symbols starting with _" - [form] - (filter #(and (list? %) - (empty? (find-holes %))) - (tree-seq seq? seq form))) - -(defn flatten-map - "Transforms a map into a vector like [key value key value]." - [m] - (reduce (fn [coll [k v]] (conj coll k v)) - [] m)) - -(defn template? - "Returns true if form is a valid template expression." - [form] - (if (seq (find-holes form)) true false)) - -(defmacro template - "Expands to a fn using _1, _2, _3, etc. as arguments (_ is the same - as _1). Any sub-expressions without any _* variables are evaluated - when the fn is created, not when it is called." - [& form] - (when-not (template? form) - (throw (IllegalArgumentException. (str (pr-str form) " is not a valid template.")))) - (let [form (postwalk-replace {'_ '_1} form) - holes (find-holes form) - pures (find-pure-exprs form) - smap (zipmap pures (repeatedly #(gensym "HOLE_"))) - newform (prewalk-replace smap form) - ;; Now, make sure we omit nested sub-expressions: - used (set (filter #(.startsWith (name %) "HOLE_") - (find-symbols newform))) - newmap (reduce (fn [m [k v]] (if (used v) (assoc m k v) m)) - {} smap)] - `(let ~(flatten-map (clojure.set/map-invert newmap)) - (fn ~(vec holes) - ~@newform)))) - -(defn apply-template - "Replaces _1, _2, _3, etc. in expr with corresponding elements of - values. Returns the modified expression. For use in macros." - [expr values] - (when-not (template? expr) - (throw (IllegalArgumentException. (str (pr-str expr) " is not a valid template.")))) - (let [expr (postwalk-replace {'_ '_1} expr) - holes (find-holes expr) - smap (zipmap holes values)] - (prewalk-replace smap expr))) - -(defmacro do-template - "Repeatedly evaluates template expr (in a do block) using values in - args. args are grouped by the number of holes in the template. - Example: (do-template (check _1 _2) :a :b :c :d) - expands to (do (check :a :b) (check :c :d))" - [expr & args] - (when-not (template? expr) - (throw (IllegalArgumentException. (str (pr-str expr) " is not a valid template.")))) - (let [expr (postwalk-replace {'_ '_1} expr) - argcount (count (find-holes expr))] - `(do ~@(map (fn [a] (apply-template expr a)) - (partition argcount args))))) diff --git a/src/clojure/contrib/test_clojure.clj b/src/clojure/contrib/test_clojure.clj deleted file mode 100644 index 280c6a96..00000000 --- a/src/clojure/contrib/test_clojure.clj +++ /dev/null @@ -1,66 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. 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.contrib.test-clojure -;; -;; Tests for the facilities provided by Clojure -;; -;; scgilardi (gmail) -;; Created 22 October 2008 - -(ns clojure.contrib.test-clojure - (:use [clojure.contrib.test-is :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 - ;; libraries - :clojure-main - :clojure-set - :clojure-xml - :clojure-zip - ]) - -(def test-namespaces - (map #(symbol (str "clojure.contrib.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/src/clojure/contrib/test_clojure/agents.clj b/src/clojure/contrib/test_clojure/agents.clj deleted file mode 100644 index 34dfb2a1..00000000 --- a/src/clojure/contrib/test_clojure/agents.clj +++ /dev/null @@ -1,41 +0,0 @@ -;; Copyright (c) Shawn Hoover. 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. - -(ns clojure.contrib.test-clojure.agents - (:use clojure.contrib.test-is)) - -(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/src/clojure/contrib/test_clojure/atoms.clj b/src/clojure/contrib/test_clojure/atoms.clj deleted file mode 100644 index 0b0dbd91..00000000 --- a/src/clojure/contrib/test_clojure/atoms.clj +++ /dev/null @@ -1,18 +0,0 @@ -;; Copyright (c) Frantisek Sodomka. 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. - -(ns clojure.contrib.test-clojure.atoms - (:use clojure.contrib.test-is)) - -; http://clojure.org/atoms - -; atom -; deref, @-reader-macro -; swap! reset! -; compare-and-set! - diff --git a/src/clojure/contrib/test_clojure/clojure_main.clj b/src/clojure/contrib/test_clojure/clojure_main.clj deleted file mode 100644 index f1a96465..00000000 --- a/src/clojure/contrib/test_clojure/clojure_main.clj +++ /dev/null @@ -1,18 +0,0 @@ -;; Copyright (c) Shawn Hoover. 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. - -(ns clojure.contrib.test-clojure.clojure-main - (:use [clojure.contrib.java-utils :only (with-system-properties)] - clojure.contrib.test-is) - (:require [clojure.main :as main])) - -(deftest compile-path-respects-java-property - ;; Bug fixed in r1177; previously was hardwired to the compile-time path. - (with-system-properties {:clojure.compile.path "compile path test"} - (main/with-bindings - (is (= "compile path test" *compile-path*))))) diff --git a/src/clojure/contrib/test_clojure/clojure_set.clj b/src/clojure/contrib/test_clojure/clojure_set.clj deleted file mode 100644 index 33e9f2c3..00000000 --- a/src/clojure/contrib/test_clojure/clojure_set.clj +++ /dev/null @@ -1,117 +0,0 @@ -;; Copyright (c) Frantisek Sodomka. 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. - -(ns clojure.contrib.test-clojure.clojure-set - (:use clojure.contrib.test-is) - (:require [clojure.set :as set])) - - -(deftest test-union - (are (= _1 _2) - (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 (= _1 _2) - ; 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/src/clojure/contrib/test_clojure/clojure_xml.clj b/src/clojure/contrib/test_clojure/clojure_xml.clj deleted file mode 100644 index ebcddc81..00000000 --- a/src/clojure/contrib/test_clojure/clojure_xml.clj +++ /dev/null @@ -1,18 +0,0 @@ -;; Copyright (c) Frantisek Sodomka. 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. - -(ns clojure.contrib.test-clojure.clojure-xml - (:use clojure.contrib.test-is) - (:require [clojure.xml :as xml])) - - -; parse - -; emit-element -; emit - diff --git a/src/clojure/contrib/test_clojure/clojure_zip.clj b/src/clojure/contrib/test_clojure/clojure_zip.clj deleted file mode 100644 index b400c863..00000000 --- a/src/clojure/contrib/test_clojure/clojure_zip.clj +++ /dev/null @@ -1,45 +0,0 @@ -;; Copyright (c) Frantisek Sodomka. 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. - -(ns clojure.contrib.test-clojure.clojure-zip - (:use clojure.contrib.test-is) - (: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/src/clojure/contrib/test_clojure/compilation.clj b/src/clojure/contrib/test_clojure/compilation.clj deleted file mode 100644 index 8f7bad90..00000000 --- a/src/clojure/contrib/test_clojure/compilation.clj +++ /dev/null @@ -1,36 +0,0 @@ -;; Copyright (c) Frantisek Sodomka. 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. - -(ns clojure.contrib.test-clojure.compilation - (:use clojure.contrib.test-is)) - -; http://clojure.org/compilation - -; compile -; gen-class, gen-interface - - -(deftest test-compiler-metadata - (let [m ^#'when] - (are (= _1 _2) - (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/src/clojure/contrib/test_clojure/control.clj b/src/clojure/contrib/test_clojure/control.clj deleted file mode 100644 index 15542bf6..00000000 --- a/src/clojure/contrib/test_clojure/control.clj +++ /dev/null @@ -1,114 +0,0 @@ -;; Copyright (c) Frantisek Sodomka. 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 "flow control" constructs. -;; - -(ns clojure.contrib.test-clojure.control - (:use clojure.contrib.test-is - [clojure.contrib.test-clojure.test-utils :only (exception)])) - -;; *** Helper functions *** - -(defn maintains-identity [f] - (are (= (f _) _) - 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 (= _1 _2) - ; 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 (= _1 _2) - (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 (= (cond _ :a true :b) :b) - nil false ) - - ; true - (are (= (cond _ :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 (= _1 _2) - (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/src/clojure/contrib/test_clojure/data_structures.clj b/src/clojure/contrib/test_clojure/data_structures.clj deleted file mode 100644 index 8dda7182..00000000 --- a/src/clojure/contrib/test_clojure/data_structures.clj +++ /dev/null @@ -1,733 +0,0 @@ -;; Copyright (c) Frantisek Sodomka. 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. -;; - -(ns clojure.contrib.test-clojure.data-structures - (:use clojure.contrib.test-is - [clojure.contrib.test-clojure.test-utils :only (all-are)])) - - -;; *** 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 (not (= nil _)) - 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 (= _1 _2) - '() [] ; 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 (not= _1 _2) - ; only () equals [] - () #{} - () {} - [] #{} - [] {} - #{} {} - ; only '(1) equals [1] - '(1) #{1} - [1] #{1} ) - - ; sorted-map, hash-map and array-map - classes differ, but content is equal - (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 (and (not= (class (struct equality-struct 1 2)) (class _)) - (= (struct equality-struct 1 2) _)) - (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 (= _1 _2) - (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 (= _1 _2) - (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 (= (count [_]) 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 (= _1 _2) - (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 (= _1 _2) - (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 (= _1 _2) - (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 (list? _) - () - '() - (list) - (list 1 2 3) ) - - ; order is important - (are (not (= _1 _2)) - (list 1 2) (list 2 1) - (list 3 1 2) (list 1 2 3) ) - - (are (= _1 _2) - '() () - (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 (= _1 _2) - (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 (= _1 _2) - (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 (= _1 _2) - (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 (= _ 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 (= _1 _2) ; other than map data structures - (keys ()) nil - (keys []) nil - (keys #{}) nil - (keys "") nil ) - - (are (= _1 _2) - ; (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 (= _1 _2) ; other than map data structures - (vals ()) nil - (vals []) nil - (vals #{}) nil - (vals "") nil ) - - (are (= _1 _2) - ; (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 (= (key (first (hash-map _ :value))) _) - 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 (= (val (first (hash-map :key _))) _) - 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 (set? _) - #{} - #{1 2} - (hash-set) - (hash-set 1 2) ) - - ; order isn't important - (are (= _1 _2) - #{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 (and (= (hash-set _) #{_}) - (= (hash-set _ _) #{_})) - 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 (= _1 _2) - ; 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 (set? _) - (sorted-set) - (sorted-set 1 2) ) - - ; equal and unique - (are (and (= (sorted-set _) #{_}) - (= (sorted-set _ _) (sorted-set _))) - 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 (= _1 _2) - ; 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 (set? (set _)) - () '(1 2) - [] [1 2] - #{} #{1 2} - {} {:a 1 :b 2} - (into-array []) (into-array [1 2]) - "" "abc" ) - - ; unique - (are (= (set [_ _]) #{_}) - 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 (= (set _1) _2) - () #{} - '(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 (= (disj _) _) - #{} - #{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 (= (class (disj _)) (class _)) - (hash-set) - (hash-set 1 2) - (sorted-set) - (sorted-set 1 2) ) - - (are (= _1 _2) - (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/src/clojure/contrib/test_clojure/evaluation.clj b/src/clojure/contrib/test_clojure/evaluation.clj deleted file mode 100644 index fdd84bba..00000000 --- a/src/clojure/contrib/test_clojure/evaluation.clj +++ /dev/null @@ -1,230 +0,0 @@ -;; Copyright (c) J. McConnell. All rights reserved. The use and -;; distribution terms for this software are covered by the Common Public -;; License 1.0 (http://opensource.org/licenses/cpl.php) which can be found -;; in the file CPL.TXT 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.contrib.test-clojure.evaluation.clj -;; -;; Tests for the Clojure functions documented at the URL: -;; -;; http://clojure.org/Evaluation -;; -;; by J. McConnell, http://ubermenschconsulting.com -;; Created 22 October 2008 - -(ns clojure.contrib.test-clojure.evaluation - (:use clojure.contrib.test-is)) - -(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 test-is 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.contrib.test-is)) - (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.contrib.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.contrib.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/src/clojure/contrib/test_clojure/for.clj b/src/clojure/contrib/test_clojure/for.clj deleted file mode 100644 index 1b3dcb4d..00000000 --- a/src/clojure/contrib/test_clojure/for.clj +++ /dev/null @@ -1,123 +0,0 @@ -;; Copyright (c) Chris Houser. All rights reserved. The use and -;; distribution terms for this software are covered by the Common Public -;; License 1.0 (http://opensource.org/licenses/cpl.php) which can be found -;; in the file CPL.TXT 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, http://chouser.n01se.net -;; Created Dec 2008 - -(ns clojure.contrib.test-clojure.for - (:use clojure.contrib.test-is)) - -(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/src/clojure/contrib/test_clojure/java_interop.clj b/src/clojure/contrib/test_clojure/java_interop.clj deleted file mode 100644 index 62eec24e..00000000 --- a/src/clojure/contrib/test_clojure/java_interop.clj +++ /dev/null @@ -1,404 +0,0 @@ -;; Copyright (c) Frantisek Sodomka. 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. - -(ns clojure.contrib.test-clojure.java-interop - (:use clojure.contrib.test-is)) - -; http://clojure.org/java_interop -; http://clojure.org/compilation - - -(deftest test-dot - ; (.instanceMember instance args*) - (are (= _ "FRED") - (.toUpperCase "fred") - (. "fred" toUpperCase) - (. "fred" (toUpperCase)) ) - - (are (= _ true) - (.startsWith "abcde" "ab") - (. "abcde" startsWith "ab") - (. "abcde" (startsWith "ab")) ) - - ; (.instanceMember Classname args*) - (are (= _ "java.lang.String") - (.getName String) - (. (identity String) getName) - (. (identity String) (getName)) ) - - ; (Classname/staticMethod args*) - (are (= _ 7) - (Math/abs -7) - (. Math abs -7) - (. Math (abs -7)) ) - - ; Classname/staticField - (are (= _ 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 (= _1 _2) - (class m) java.util.HashMap - m {"a" 1 "b" 2} ))) - - -(deftest test-new - ; Integer - (are (and (= (class _1) _2) - (= _1 _3)) - (new java.lang.Integer 42) java.lang.Integer 42 - (java.lang.Integer. 123) java.lang.Integer 123 ) - - ; Date - (are (= (class _) java.util.Date) - (new java.util.Date) - (java.util.Date.) )) - - -(deftest test-instance? - ; evaluation - (are (= _1 _2) - (instance? java.lang.Integer (+ 1 2)) true - (instance? java.lang.Long (+ 1 2)) false ) - - ; different types - (are (instance? _2 _1) - 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 (= (instance? _1 42) _2) - 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 (= _1 _2) - (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 (= _1 _2) - (bases java.lang.Math) - (list java.lang.Object) - (bases java.lang.Integer) - (list java.lang.Number java.lang.Comparable) )) - -(deftest test-supers - (are (= _1 _2) - (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 (and (= (alength (~type-array _)) _) - (= (vec (~type-array _)) (repeat _ 0))) - 0 1 5 ) - - ; copy of a sequence - (are (and (= (alength (~type-array _)) (count _)) - (= (vec (~type-array _)) _)) -;; [] ;; ERROR - [1] - [1 -2 3 0 5] ) - - ; given size and init-value - (are (and (= (alength (~type-array _ 42)) _) - (= (vec (~type-array _ 42)) (repeat _ 42))) - 0 1 5 ) - - ; given size and init-seq - (are (and (= (alength (~type-array _1 _2)) _1) - (= (vec (~type-array _1 _2)) _3)) - 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 (thrown? NegativeArraySizeException _) - (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 (= (alength (make-array Integer _)) _) - 0 1 5 ) - - (let [a (make-array Integer 5)] - (aset a 3 42) - (are (= _1 _2) - (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 (= _1 _2) - (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 (= _1 _2) - ; 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 (and (= (alength (to-array _)) (count _)) - (= (vec (to-array _)) (vec _))) - () - '(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 (= _1 _2) - (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 (= _ Integer) - (class (aget a 0)) - (class (aget a 1)) - (class (aget a 2)) )) - - ; different kinds of collections - (are (and (= (alength (into-array _)) (count _)) - (= (vec (into-array _)) (vec _)) - (= (alength (into-array Integer/TYPE _)) (count _)) - (= (vec (into-array Integer/TYPE _)) (vec _))) - () - '(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 (= _1 _2) - (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 (= _1 _2) - (alength a) 0 - (vec a) [] ))) - - -(deftest test-alength - (are (= (alength _) 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 (= (alength _) 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 (= (alength _) 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 (and (= (alength (aclone _)) (alength _)) - (= (vec (aclone _)) (vec _))) - (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 (and (= (alength (aclone _)) (alength _)) - (= (map alength (aclone _)) (map alength _)) - (= (map vec (aclone _)) (map vec _))) - (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 (and (instance? java.lang.Boolean (boolean _1)) - (= (boolean _1) _2)) - 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/src/clojure/contrib/test_clojure/logic.clj b/src/clojure/contrib/test_clojure/logic.clj deleted file mode 100644 index 40a94c37..00000000 --- a/src/clojure/contrib/test_clojure/logic.clj +++ /dev/null @@ -1,202 +0,0 @@ -;; Copyright (c) Frantisek Sodomka. 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. -;; -;; Created 1/29/2009 - -(ns clojure.contrib.test-clojure.logic - (:use clojure.contrib.test-is - [clojure.contrib.test-clojure.test-utils :only (exception)])) - - -;; *** Tests *** - -(deftest test-if - ; true/false/nil - (are (= _1 _2) - (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 (= (if _ :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 (= (if _ :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 (= (if _1 :no :yes) _2) - (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 (= _1 _2) - (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 (= _1 _2) - (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 (= (not _) true) - nil - false ) - (are (= (not _) 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/src/clojure/contrib/test_clojure/macros.clj b/src/clojure/contrib/test_clojure/macros.clj deleted file mode 100644 index 40fd99ba..00000000 --- a/src/clojure/contrib/test_clojure/macros.clj +++ /dev/null @@ -1,16 +0,0 @@ -;; Copyright (c) Frantisek Sodomka. 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. - -(ns clojure.contrib.test-clojure.macros - (:use clojure.contrib.test-is)) - -; http://clojure.org/macros - -; -> -; defmacro definline macroexpand-1 macroexpand - diff --git a/src/clojure/contrib/test_clojure/metadata.clj b/src/clojure/contrib/test_clojure/metadata.clj deleted file mode 100644 index ea0cdbe1..00000000 --- a/src/clojure/contrib/test_clojure/metadata.clj +++ /dev/null @@ -1,17 +0,0 @@ -;; Copyright (c) Frantisek Sodomka. 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. - -(ns clojure.contrib.test-clojure.metadata - (:use clojure.contrib.test-is)) - - -; http://clojure.org/metadata - -; meta -; with-meta - diff --git a/src/clojure/contrib/test_clojure/multimethods.clj b/src/clojure/contrib/test_clojure/multimethods.clj deleted file mode 100644 index b273a0bd..00000000 --- a/src/clojure/contrib/test_clojure/multimethods.clj +++ /dev/null @@ -1,25 +0,0 @@ -;; Copyright (c) Frantisek Sodomka. 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. - -(ns clojure.contrib.test-clojure.multimethods - (:use clojure.contrib.test-is)) - -; http://clojure.org/multimethods - -; defmulti -; defmethod -; remove-method -; prefer-method -; methods -; prefers - -; derive, [underive] -; isa? -; parents, ancestors, descendants -; make-hierarchy - diff --git a/src/clojure/contrib/test_clojure/ns_libs.clj b/src/clojure/contrib/test_clojure/ns_libs.clj deleted file mode 100644 index 50822d46..00000000 --- a/src/clojure/contrib/test_clojure/ns_libs.clj +++ /dev/null @@ -1,26 +0,0 @@ -;; Copyright (c) Frantisek Sodomka. 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. - -(ns clojure.contrib.test-clojure.ns-libs - (:use clojure.contrib.test-is)) - -; 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/src/clojure/contrib/test_clojure/numbers.clj b/src/clojure/contrib/test_clojure/numbers.clj deleted file mode 100644 index 82450641..00000000 --- a/src/clojure/contrib/test_clojure/numbers.clj +++ /dev/null @@ -1,390 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. 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. -;; -;; scgilardi (gmail) -;; Created 30 October 2008 -;; - -(ns clojure.contrib.test-clojure.numbers - (:use clojure.contrib.test-is)) - - -; TODO: -; == -; and more... - - -;; *** Types *** - -(deftest Coerced-Byte - (let [v (byte 3)] - (are _ - (instance? Byte v) - (number? v) - (integer? v) - (rational? v)))) - -(deftest Coerced-Short - (let [v (short 3)] - (are _ - (instance? Short v) - (number? v) - (integer? v) - (rational? v)))) - -(deftest Coerced-Integer - (let [v (int 3)] - (are _ - (instance? Integer v) - (number? v) - (integer? v) - (rational? v)))) - -(deftest Coerced-Long - (let [v (long 3)] - (are _ - (instance? Long v) - (number? v) - (integer? v) - (rational? v)))) - -(deftest Coerced-BigInteger - (let [v (bigint 3)] - (are _ - (instance? BigInteger v) - (number? v) - (integer? v) - (rational? v)))) - -(deftest Coerced-Float - (let [v (float 3)] - (are _ - (instance? Float v) - (number? v) - (float? v)))) - -(deftest Coerced-Double - (let [v (double 3)] - (are _ - (instance? Double v) - (number? v) - (float? v)))) - -(deftest Coerced-BigDecimal - (let [v (bigdec 3)] - (are _ - (instance? BigDecimal v) - (number? v) - (decimal? v) - (not (float? v))))) - - -;; *** Functions *** - -(defonce DELTA 1e-12) - -(deftest test-add - (are (= _1 _2) - (+) 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 (< (- _1 _2) 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 (= _1 _2) - (- 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 (< (- _1 _2) 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 (= _1 _2) - (*) 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 (< (- _1 _2) 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 (= _1 _2) - (/ 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 (< (- _1 _2) 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 (= _1 _2) - (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 (= _1 _2) - (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 (= _1 _2) - (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 _ - (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 _ - (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/src/clojure/contrib/test_clojure/other_functions.clj b/src/clojure/contrib/test_clojure/other_functions.clj deleted file mode 100644 index 3138fbd9..00000000 --- a/src/clojure/contrib/test_clojure/other_functions.clj +++ /dev/null @@ -1,57 +0,0 @@ -;; Copyright (c) Frantisek Sodomka. 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. - -(ns clojure.contrib.test-clojure.other-functions - (:use clojure.contrib.test-is)) - -; 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 (= (identity _) _) - 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 (= (identity _1) _2) - (+ 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/src/clojure/contrib/test_clojure/parallel.clj b/src/clojure/contrib/test_clojure/parallel.clj deleted file mode 100644 index 855e507b..00000000 --- a/src/clojure/contrib/test_clojure/parallel.clj +++ /dev/null @@ -1,26 +0,0 @@ -;; Copyright (c) Frantisek Sodomka. 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. - -(ns clojure.contrib.test-clojure.parallel - (:use clojure.contrib.test-is)) - -;; !! 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/src/clojure/contrib/test_clojure/predicates.clj b/src/clojure/contrib/test_clojure/predicates.clj deleted file mode 100644 index 0206860d..00000000 --- a/src/clojure/contrib/test_clojure/predicates.clj +++ /dev/null @@ -1,139 +0,0 @@ -;; Copyright (c) Frantisek Sodomka. 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. -;; -;; Created 1/28/2009 - -(ns clojure.contrib.test-clojure.predicates - (:use clojure.contrib.test-is)) - - -;; *** 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/src/clojure/contrib/test_clojure/printer.clj b/src/clojure/contrib/test_clojure/printer.clj deleted file mode 100644 index 4e307099..00000000 --- a/src/clojure/contrib/test_clojure/printer.clj +++ /dev/null @@ -1,81 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. 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.contrib.test-clojure.printer -;; -;; scgilardi (gmail) -;; Created 29 October 2008 - -(ns clojure.contrib.test-clojure.printer - (:use clojure.contrib.test-is)) - -(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/src/clojure/contrib/test_clojure/reader.clj b/src/clojure/contrib/test_clojure/reader.clj deleted file mode 100644 index 3c771934..00000000 --- a/src/clojure/contrib/test_clojure/reader.clj +++ /dev/null @@ -1,203 +0,0 @@ -;; Copyright (c) Stephen C. Gilardi. 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/Reader -;; -;; scgilardi (gmail) -;; Created 22 October 2008 - -(ns clojure.contrib.test-clojure.reader - (:use clojure.contrib.test-is)) - -;; 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.0e1)) - (is (instance? Double +1.0)) - (is (instance? Double 1.0)) - (is (instance? Double +0.0)) - (is (instance? Double 0.0)) - (is (instance? Double -0.0)) - (is (instance? Double -1.0)) - (is (instance? Double -1.0e1)) - - ; 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.0M)) - (is (instance? BigDecimal 1.0M)) - (is (instance? BigDecimal +0.0M)) - (is (instance? BigDecimal 0.0M)) - (is (instance? BigDecimal -0.0M)) - (is (instance? BigDecimal -1.0M)) -) - -;; 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/src/clojure/contrib/test_clojure/refs.clj b/src/clojure/contrib/test_clojure/refs.clj deleted file mode 100644 index dcc43cc4..00000000 --- a/src/clojure/contrib/test_clojure/refs.clj +++ /dev/null @@ -1,19 +0,0 @@ -;; Copyright (c) Frantisek Sodomka. 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. - -(ns clojure.contrib.test-clojure.refs - (:use clojure.contrib.test-is)) - -; http://clojure.org/refs - -; ref -; deref, @-reader-macro -; dosync io! -; ensure ref-set alter commute -; set-validator get-validator - diff --git a/src/clojure/contrib/test_clojure/sequences.clj b/src/clojure/contrib/test_clojure/sequences.clj deleted file mode 100644 index 7c2721b4..00000000 --- a/src/clojure/contrib/test_clojure/sequences.clj +++ /dev/null @@ -1,982 +0,0 @@ -;; Copyright (c) Frantisek Sodomka. 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. -;; - -(ns clojure.contrib.test-clojure.sequences - (:use clojure.contrib.test-is)) - - -;; *** Tests *** - -; TODO: -; apply, map, reduce, filter, remove -; and more... - - -(deftest test-equality - ; lazy sequences - (are (= _1 _2) - ; 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 (seq? _) - (lazy-seq nil) - (lazy-seq []) - (lazy-seq [1 2])) - - (are (= _1 _2) - (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 (= _1 _2) - (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 (= _1 _2) - (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 (and (= (empty _1) _2) - (= (class (empty _1)) (class _2))) - 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 (= (not-empty _) nil) - () - [] - {} - #{} - (seq ()) - (seq []) - (lazy-seq ()) - (lazy-seq []) ) - - ; non-empty coll/seq => identity - (are (and (= (not-empty _) _) - (= (class (not-empty _)) (class _))) - '(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 (= _1 _2) - (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 (= _1 _2) - (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 (= _1 _2) - (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 (= _1 _2) - (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 (= _1 _2) - (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 (= _1 _2) - (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 (= _1 _2) - (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 (= _1 _2) - (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 (= _1 _2) - (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 (= _1 _2) - (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 (= _1 _2) - (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 (= (distinct [_ _]) [_]) ; (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 (= _1 _2) - (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 (= _1 _2) - (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 (= _1 _2) - (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 (= _1 _2) - (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 (= _1 _2) - (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 (= _1 _2) - (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 (= _1 _2) - (reverse nil) () ; since SVN 1294 - (reverse []) () - (reverse [1]) '(1) - (reverse [1 2 3]) '(3 2 1) )) - - -(deftest test-take - (are (= _1 _2) - (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 (= _1 _2) - (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 (= _1 _2) - (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 (= _1 _2) - (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 (= _1 _2) - (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 (= _1 _2) - (butlast []) nil - (butlast [1]) nil - (butlast [1 2 3]) '(1 2) )) - - -(deftest test-drop-last - (are (= _1 _2) - ; 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 (= _1 _2) - (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 (= _1 _2) - (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 (= _1 _2) - (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 (= _1 _2) - (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 (= (repeat 3 _) (list _ _ _)) - 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 (= _1 _2) - (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 (empty? _) - nil - () - (lazy-seq nil) ; => () - [] - {} - #{} - "" - (into-array []) ) - - (are (not (empty? _)) - '(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 (= (every? pos? _) true) - nil - () [] {} #{} - (lazy-seq []) - (into-array []) ) - - (are (= _1 _2) - 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 (= _1 _2) - 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 (= (not-every? pos? _) false) - nil - () [] {} #{} - (lazy-seq []) - (into-array []) ) - - (are (= _1 _2) - 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 (= _1 _2) - 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 (= (not-any? pos? _) true) - nil - () [] {} #{} - (lazy-seq []) - (into-array []) ) - - (are (= _1 _2) - 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 (= _1 _2) - false (not-any? #{:a} [:a :a]) - false (not-any? #{:a} [:a :b]) - true (not-any? #{:a} [:b :b]) )) - - -; TODO: some - diff --git a/src/clojure/contrib/test_clojure/special.clj b/src/clojure/contrib/test_clojure/special.clj deleted file mode 100644 index 298ef534..00000000 --- a/src/clojure/contrib/test_clojure/special.clj +++ /dev/null @@ -1,21 +0,0 @@ -;; Copyright (c) Frantisek Sodomka. 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 special forms, macros and metadata -;; - -(ns clojure.contrib.test-clojure.special - (:use clojure.contrib.test-is)) - -; http://clojure.org/special_forms - -; let, letfn -; quote -; var -; fn - diff --git a/src/clojure/contrib/test_clojure/test_utils.clj b/src/clojure/contrib/test_clojure/test_utils.clj deleted file mode 100644 index fc858f2d..00000000 --- a/src/clojure/contrib/test_clojure/test_utils.clj +++ /dev/null @@ -1,33 +0,0 @@ -;; Copyright (c) Frantisek Sodomka. 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. - -(ns clojure.contrib.test-clojure.test-utils - (:use [clojure.contrib.combinatorics :only (combinations)])) - - -(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.contrib.test-is/is expr)) - (apply concat (combinations args 2)))) - diff --git a/src/clojure/contrib/test_clojure/vars.clj b/src/clojure/contrib/test_clojure/vars.clj deleted file mode 100644 index f3b2e8ff..00000000 --- a/src/clojure/contrib/test_clojure/vars.clj +++ /dev/null @@ -1,34 +0,0 @@ -;; Copyright (c) Frantisek Sodomka. 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. - -(ns clojure.contrib.test-clojure.vars - (:use clojure.contrib.test-is)) - -; http://clojure.org/vars - -; def -; defn defn- defonce - -; declare intern binding find-var var - -(def a) -(deftest test-binding - (are (= _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 - -; set-validator get-validator - -; doc find-doc test - diff --git a/src/clojure/contrib/test_contrib.clj b/src/clojure/contrib/test_contrib.clj index f5cf44ea..a846ab17 100644 --- a/src/clojure/contrib/test_contrib.clj +++ b/src/clojure/contrib/test_contrib.clj @@ -13,14 +13,13 @@ ;; stuart.halloway (gmail) (ns clojure.contrib.test-contrib - (:use [clojure.contrib.test-is :only (run-tests)]) + (:use [clojure.test :only (run-tests)]) (:gen-class)) (def test-names [:complex-numbers :fnmap :macro-utils :monads :pprint.pretty :pprint.cl-format :str-utils :shell-out :test-graph - :test-dataflow :test-java-utils :test-lazy-seqs :test-is - :test-is-fixtures]) + :test-dataflow :test-java-utils :test-lazy-seqs]) (def test-namespaces (map #(symbol (str "clojure.contrib.test-contrib." (name %))) diff --git a/src/clojure/contrib/test_contrib/complex_numbers.clj b/src/clojure/contrib/test_contrib/complex_numbers.clj index 2ac2ff86..7498e897 100644 --- a/src/clojure/contrib/test_contrib/complex_numbers.clj +++ b/src/clojure/contrib/test_contrib/complex_numbers.clj @@ -13,7 +13,7 @@ (ns clojure.contrib.test-contrib.complex-numbers (:refer-clojure :exclude [+ - * / = < > <= >=]) - (:use [clojure.contrib.test-is + (:use [clojure.test :only (deftest is are run-tests)] [clojure.contrib.generic.arithmetic :only (+ - * /)] diff --git a/src/clojure/contrib/test_contrib/fnmap.clj b/src/clojure/contrib/test_contrib/fnmap.clj index ccd7a54a..7fe87cc3 100644 --- a/src/clojure/contrib/test_contrib/fnmap.clj +++ b/src/clojure/contrib/test_contrib/fnmap.clj @@ -1,19 +1,19 @@ (ns clojure.contrib.test-contrib.fnmap (:use clojure.contrib.fnmap - clojure.contrib.test-is)) + clojure.test)) (deftest acts-like-map (let [m1 (fnmap get assoc :key1 1 :key2 2)] - (are (= _2 (get m1 _1)) + (are [k v] (= v (get m1 k)) :key1 1 :key2 2 :nonexistent-key nil) - (are (= _2 (_1 m1)) + (are [k v] (= v (k m1)) :key1 1 :key2 2 :nonexistent-key nil) (let [m2 (assoc m1 :key3 3 :key4 4)] - (are (= _2 (get m2 _1)) + (are [k v] (= v (get m2 k)) :key1 1 :key2 2 :key3 3 diff --git a/src/clojure/contrib/test_contrib/greatest_least.clj b/src/clojure/contrib/test_contrib/greatest_least.clj index 557c0a3c..f273aaf2 100644 --- a/src/clojure/contrib/test_contrib/greatest_least.clj +++ b/src/clojure/contrib/test_contrib/greatest_least.clj @@ -1,6 +1,6 @@ (ns clojure.contrib.test-contrib.greatest-least (:use clojure.contrib.greatest-least - [clojure.contrib.test-is :only (is deftest run-tests)])) + [clojure.test :only (is deftest run-tests)])) (deftest test-greatest (is (nil? (greatest)) "greatest with no arguments is nil") diff --git a/src/clojure/contrib/test_contrib/macro_utils.clj b/src/clojure/contrib/test_contrib/macro_utils.clj index 01c64678..ac1ced06 100644 --- a/src/clojure/contrib/test_contrib/macro_utils.clj +++ b/src/clojure/contrib/test_contrib/macro_utils.clj @@ -12,7 +12,7 @@ ;; remove this notice, or any other, from this software. (ns clojure.contrib.test-contrib.macro-utils - (:use [clojure.contrib.test-is :only (deftest is are run-tests use-fixtures)] + (:use [clojure.test :only (deftest is are run-tests use-fixtures)] [clojure.contrib.macro-utils :only (macrolet symbol-macrolet defsymbolmacro with-symbol-macros mexpand-1 mexpand mexpand-all)] diff --git a/src/clojure/contrib/test_contrib/monads.clj b/src/clojure/contrib/test_contrib/monads.clj index 5d38b544..f523f0ec 100644 --- a/src/clojure/contrib/test_contrib/monads.clj +++ b/src/clojure/contrib/test_contrib/monads.clj @@ -12,14 +12,14 @@ ;; remove this notice, or any other, from this software. (ns clojure.contrib.test-contrib.monads - (:use [clojure.contrib.test-is :only (deftest is are run-tests)] + (:use [clojure.test :only (deftest is are run-tests)] [clojure.contrib.monads :only (with-monad domonad m-lift m-seq m-chain sequence-m maybe-m state-m maybe-t sequence-t)])) (deftest sequence-monad (with-monad sequence-m - (are (= _1 _2) + (are [a b] (= a b) (domonad [x (range 3) y (range 2)] (+ x y)) '(0 1 1 2 2 3) (domonad [x (range 5) y (range (+ 1 x)) :when (= (+ x y) 2)] (list x y)) @@ -37,7 +37,7 @@ (with-monad maybe-m (let [m+ (m-lift 2 +) mdiv (fn [x y] (domonad [a x b y :when (not (zero? b))] (/ a b)))] - (are (= _1 _2) + (are [a b] (= a b) (m+ (m-result 1) (m-result 3)) (m-result 4) (mdiv (m-result 1) (m-result 3)) @@ -50,7 +50,7 @@ (deftest seq-maybe-monad (with-monad (maybe-t sequence-m) (letfn [(pairs [xs] ((m-lift 2 #(list %1 %2)) xs xs))] - (are (= _1 _2) + (are [a b] (= a b) ((m-lift 1 inc) (for [n (range 10)] (when (odd? n) n))) '(nil 2 nil 4 nil 6 nil 8 nil 10) (pairs (for [n (range 5)] (when (odd? n) n))) diff --git a/src/clojure/contrib/test_contrib/pprint/cl_format.clj b/src/clojure/contrib/test_contrib/pprint/cl_format.clj index 3de10959..b101b92b 100644 --- a/src/clojure/contrib/test_contrib/pprint/cl_format.clj +++ b/src/clojure/contrib/test_contrib/pprint/cl_format.clj @@ -15,7 +15,7 @@ (ns clojure.contrib.test-contrib.pprint.cl-format (:refer-clojure :exclude [format]) - (:use [clojure.contrib.test-is :only (deftest are run-tests)] + (:use [clojure.test :only (deftest are run-tests)] clojure.contrib.test-contrib.pprint.helper clojure.contrib.pprint)) diff --git a/src/clojure/contrib/test_contrib/pprint/helper.clj b/src/clojure/contrib/test_contrib/pprint/helper.clj index c7112e68..bf25ca61 100644 --- a/src/clojure/contrib/test_contrib/pprint/helper.clj +++ b/src/clojure/contrib/test_contrib/pprint/helper.clj @@ -14,8 +14,8 @@ ;; This is just a macro to make my tests a little cleaner (ns clojure.contrib.test-contrib.pprint.helper - (:use [clojure.contrib.test-is :only (deftest are run-tests)])) + (:use [clojure.test :only (deftest are run-tests)])) (defmacro simple-tests [name & test-pairs] - `(deftest ~name (are (= _1 _2) ~@test-pairs))) + `(deftest ~name (are [x y] (= x y) ~@test-pairs))) diff --git a/src/clojure/contrib/test_contrib/pprint/pretty.clj b/src/clojure/contrib/test_contrib/pprint/pretty.clj index c0cbb615..f51b172f 100644 --- a/src/clojure/contrib/test_contrib/pprint/pretty.clj +++ b/src/clojure/contrib/test_contrib/pprint/pretty.clj @@ -12,7 +12,7 @@ ; You must not remove this notice, or any other, from this software. (ns clojure.contrib.test-contrib.pprint.pretty - (:use [clojure.contrib.test-is :only (deftest are run-tests)] + (:use [clojure.test :only (deftest are run-tests)] clojure.contrib.test-contrib.pprint.helper clojure.contrib.pprint)) diff --git a/src/clojure/contrib/test_contrib/shell_out.clj b/src/clojure/contrib/test_contrib/shell_out.clj index 0bd1afbe..c5447099 100644 --- a/src/clojure/contrib/test_contrib/shell_out.clj +++ b/src/clojure/contrib/test_contrib/shell_out.clj @@ -1,5 +1,5 @@ (ns clojure.contrib.test-contrib.shell-out - (:use clojure.contrib.test-is + (:use clojure.test clojure.contrib.shell-out) (:import (java.io File))) @@ -9,7 +9,7 @@ (def as-env-string ((ns-interns 'clojure.contrib.shell-out) 'as-env-string)) (deftest test-parse-args - (are (= _1 _2) + (are [x y] (= x y) {:cmd [nil] :out "UTF-8" :dir nil :env nil} (parse-args []) {:cmd ["ls"] :out "UTF-8" :dir nil :env nil} (parse-args ["ls"]) {:cmd ["ls" "-l"] :out "UTF-8" :dir nil :env nil} (parse-args ["ls" "-l"]) @@ -17,17 +17,17 @@ )) (deftest test-with-sh-dir - (are (= _1 _2) + (are [x y] (= x y) nil *sh-dir* "foo" (with-sh-dir "foo" *sh-dir*))) (deftest test-with-sh-env - (are (= _1 _2) + (are [x y] (= x y) nil *sh-env* {:KEY "VAL"} (with-sh-env {:KEY "VAL"} *sh-env*))) (deftest test-as-env-string - (are (= _1 _2) + (are [x y] (= x y) nil (as-env-string nil) ["FOO=BAR"] (seq (as-env-string {"FOO" "BAR"})) ["FOO_SYMBOL=BAR"] (seq (as-env-string {'FOO_SYMBOL "BAR"})) @@ -35,7 +35,7 @@ (deftest test-as-file - (are (= _1 _2) + (are [x y] (= x y) (File. "foo") (as-file "foo") nil (as-file nil) (File. "bar") (as-file (File. "bar"))))
\ No newline at end of file diff --git a/src/clojure/contrib/test_contrib/str_utils.clj b/src/clojure/contrib/test_contrib/str_utils.clj index 812821dc..815525bb 100644 --- a/src/clojure/contrib/test_contrib/str_utils.clj +++ b/src/clojure/contrib/test_contrib/str_utils.clj @@ -1,5 +1,5 @@ (ns clojure.contrib.test-contrib.str-utils - (:use clojure.contrib.test-is + (:use clojure.test clojure.contrib.str-utils)) diff --git a/src/clojure/contrib/test_contrib/str_utils2.clj b/src/clojure/contrib/test_contrib/str_utils2.clj index d7d9b131..dac0893a 100644 --- a/src/clojure/contrib/test_contrib/str_utils2.clj +++ b/src/clojure/contrib/test_contrib/str_utils2.clj @@ -1,6 +1,6 @@ (ns clojure.contrib.test-contrib.str-utils2 (:require [clojure.contrib.str-utils2 :as s]) - (:use clojure.contrib.test-is)) + (:use clojure.test)) (deftest t-blank (is (s/blank? nil)) diff --git a/src/clojure/contrib/test_contrib/test_dataflow.clj b/src/clojure/contrib/test_contrib/test_dataflow.clj index 9ad327eb..991e7f2e 100644 --- a/src/clojure/contrib/test_contrib/test_dataflow.clj +++ b/src/clojure/contrib/test_contrib/test_dataflow.clj @@ -15,7 +15,7 @@ (ns clojure.contrib.test-contrib.test-dataflow - (:use clojure.contrib.test-is) + (:use clojure.test) (:use clojure.contrib.dataflow)) (def df-1 diff --git a/src/clojure/contrib/test_contrib/test_graph.clj b/src/clojure/contrib/test_contrib/test_graph.clj index 425966bf..ed03b9ae 100644 --- a/src/clojure/contrib/test_contrib/test_graph.clj +++ b/src/clojure/contrib/test_contrib/test_graph.clj @@ -14,7 +14,7 @@ ;; Created 23 June 2009 (ns clojure.contrib.test-contrib.test-graph - (use clojure.contrib.test-is + (use clojure.test clojure.contrib.graph)) diff --git a/src/clojure/contrib/test_contrib/test_is.clj b/src/clojure/contrib/test_contrib/test_is.clj deleted file mode 100644 index f9e77d76..00000000 --- a/src/clojure/contrib/test_contrib/test_is.clj +++ /dev/null @@ -1,113 +0,0 @@ -;;; test_contrib/test_is.clj: unit tests for test_is.clj - -;; by Stuart Sierra, http://stuartsierra.com/ -;; January 16, 2009 - -;; Thanks to Chas Emerick, Allen Rohner, and Stuart Halloway for -;; contributions and suggestions. - -;; Copyright (c) Stuart Sierra, 2008. 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. - - -(ns clojure.contrib.test-contrib.test-is - (:use clojure.contrib.test-is)) - -(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.contrib.test-contrib.test-is)))) diff --git a/src/clojure/contrib/test_contrib/test_is_fixtures.clj b/src/clojure/contrib/test_contrib/test_is_fixtures.clj deleted file mode 100644 index 218c45d5..00000000 --- a/src/clojure/contrib/test_contrib/test_is_fixtures.clj +++ /dev/null @@ -1,42 +0,0 @@ -;;; test_is_fixtures.clj: unit tests for fixtures in test_is.clj - -;; by Stuart Sierra, http://stuartsierra.com/ -;; March 28, 2009 - -;; Copyright (c) Stuart Sierra, 2009. 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. - - -(ns clojure.contrib.test-contrib.test-is-fixtures - (:use clojure.contrib.test-is)) - -(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/src/clojure/contrib/test_contrib/test_java_utils.clj b/src/clojure/contrib/test_contrib/test_java_utils.clj index 409f07b2..8a56b197 100644 --- a/src/clojure/contrib/test_contrib/test_java_utils.clj +++ b/src/clojure/contrib/test_contrib/test_java_utils.clj @@ -1,5 +1,5 @@ (ns clojure.contrib.test-contrib.test-java-utils - (:use clojure.contrib.test-is + (:use clojure.test [clojure.contrib.duck-streams :only (spit)] clojure.contrib.java-utils) (:import [java.io File] diff --git a/src/clojure/contrib/test_contrib/test_lazy_seqs.clj b/src/clojure/contrib/test_contrib/test_lazy_seqs.clj index 3bf4ba78..33bbcae1 100644 --- a/src/clojure/contrib/test_contrib/test_lazy_seqs.clj +++ b/src/clojure/contrib/test_contrib/test_lazy_seqs.clj @@ -1,5 +1,5 @@ (ns clojure.contrib.test-contrib.test-lazy-seqs - (:use clojure.contrib.test-is + (:use clojure.test clojure.contrib.lazy-seqs)) (deftest test-fibs diff --git a/src/clojure/contrib/test_contrib/walk.clj b/src/clojure/contrib/test_contrib/walk.clj new file mode 100644 index 00000000..9e79f8d6 --- /dev/null +++ b/src/clojure/contrib/test_contrib/walk.clj @@ -0,0 +1,34 @@ +(ns clojure.contrib.test-contrib.walk + (:require [clojure.contrib.walk :as w]) + (:use clojure.test)) + +(deftest t-prewalk-replace + (is (= (w/prewalk-replace {:a :b} [:a {:a :a} (list 3 :c :a)]) + [:b {:b :b} (list 3 :c :b)]))) + +(deftest t-postwalk-replace + (is (= (w/postwalk-replace {:a :b} [:a {:a :a} (list 3 :c :a)]) + [:b {:b :b} (list 3 :c :b)]))) + +(deftest t-stringify-keys + (is (= (w/stringify-keys {:a 1, nil {:b 2 :c 3}, :d 4}) + {"a" 1, nil {"b" 2 "c" 3}, "d" 4}))) + +(deftest t-prewalk-order + (is (= (let [a (atom [])] + (w/prewalk (fn [form] (swap! a conj form) form) + [1 2 {:a 3} (list 4 [5])]) + @a) + [[1 2 {:a 3} (list 4 [5])] + 1 2 {:a 3} [:a 3] :a 3 (list 4 [5]) + 4 [5] 5]))) + +(deftest t-postwalk-order + (is (= (let [a (atom [])] + (w/postwalk (fn [form] (swap! a conj form) form) + [1 2 {:a 3} (list 4 [5])]) + @a) + [1 2 + :a 3 [:a 3] {:a 3} + 4 5 [5] (list 4 [5]) + [1 2 {:a 3} (list 4 [5])]])))
\ No newline at end of file diff --git a/src/clojure/contrib/test_is.clj b/src/clojure/contrib/test_is.clj deleted file mode 100644 index 7175fa2a..00000000 --- a/src/clojure/contrib/test_is.clj +++ /dev/null @@ -1,923 +0,0 @@ -;;; test_is.clj: test framework for Clojure - -;; by Stuart Sierra, http://stuartsierra.com/ -;; March 28, 2009 - -;; Thanks to Chas Emerick, Allen Rohner, and Stuart Halloway for -;; contributions and suggestions. - -;; Copyright (c) Stuart Sierra, 2008. 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. - - - -(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.contrib.test-is - (:require [clojure.contrib.template :as temp] - [clojure.contrib.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.contrib.template/do-template for an explanation of - templates. - - Example: (are (= _1 _2) - 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." - [expr & args] - `(temp/do-template (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/clojure/contrib/test_is/tap.clj b/src/clojure/contrib/test_is/tap.clj deleted file mode 100644 index 47310d15..00000000 --- a/src/clojure/contrib/test_is/tap.clj +++ /dev/null @@ -1,112 +0,0 @@ -;;; test_is/tap.clj: Extension to test-is for TAP output - -;; by Stuart Sierra, http://stuartsierra.com/ -;; March 31, 2009 - -;; Inspired by ClojureCheck by Meikel Brandmeyer: -;; http://kotka.de/projects/clojure/clojurecheck.html - -;; Copyright (c) Stuart Sierra, 2009. 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. - - - -;; DOCUMENTATION -;; -;; This is an extension to clojure.contrib.test-is 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.contrib.test-is/run-tests in the with-tap-output macro, -;; like this: -;; -;; (use 'clojure.contrib.test-is) -;; (use 'clojure.contrib.test-is.tap) -;; -;; (with-tap-output -;; (run-tests 'my.cool.library)) - - - -(ns clojure.contrib.test-is.tap - (:require [clojure.contrib.test-is :as t] - [clojure.contrib.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-is/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-is reporting functions that produce - TAP output" - [& body] - `(binding [t/report tap-report] - ~@body)) diff --git a/src/clojure/contrib/walk.clj b/src/clojure/contrib/walk.clj deleted file mode 100644 index 0352aeb2..00000000 --- a/src/clojure/contrib/walk.clj +++ /dev/null @@ -1,134 +0,0 @@ -;;; walk.clj - generic tree walker with replacement - -;; by Stuart Sierra, http://stuartsierra.com/ -;; December 15, 2008 - -;; Copyright (c) Stuart Sierra, 2008. 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. - - -;; 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.contrib.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 (outer (if (sorted? form) (sorted-map) {})) - (map inner form))) - (set? form) (outer (into (outer (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)) - |