Commits

Meikel Brandmeyer committed 9dda582

Major changes to for Clojure SVN 1094+

* Added AOT compilation to build process.

* Changed invocations of doseq to new vector bindings.

* Renamed namespace from de.kotka.tap to de.kotka.clojurecheck.

  • Participants
  • Parent commits 96ee739

Comments (0)

Files changed (28)

-PROJECT := tap
+PROJECT := clojurecheck
 
 SRCDIR  := src
-DISTDIR := dist
+DISTDIR := classes
 
 JAVASRC != cd ${SRCDIR} && find * -type f -name \*.java
-CLJSRC  != cd ${SRCDIR} && find * -type f \( -name \*.clj -and -not -name \*.gen.clj \)
-GCCLJSRC!= cd ${SRCDIR} && find * -type f -name \*.gen.clj
+CLJSRC  != cd ${SRCDIR} && find * -type f -name \*.clj
 DIRS    != cd ${SRCDIR} && find * -type d
 
 VERSION != shtool version -d short version.txt
-JAR     := ${PROJECT}-${VERSION}.jar
+JAR     := ${PROJECT}.jar
 TGZ     := ${PROJECT}-${VERSION}.tar.gz
 
 all: jar
 
 doc: compile
 	( cat README.txt.in; \
-	  java clojure.lang.Script gen-docs.clj ) > README.txt
+	  env CLASSPATH=classes:$${CLASSPATH} java clojure.lang.Script gen-docs.clj ) > README.txt
 
 clean:
 	rm -rf ${DISTDIR} ${JAR} ${TGZ} README.txt
 
-compile: ${CLJSRC:C/^/dist\//} ${GCCLJSRC:R:R:C/^/dist\//:C/$/.class/}
+compile: ${CLJSRC:C/^/src\//} ${DISTDIR}
+	env CLASSPATH=src:classes:$${CLASSPATH} java clojure.lang.Script compile.clj
 
 bump-version:
 	shtool version -l txt -n ${PROJECT} -i v version.txt
 bump-level:
 	shtool version -l txt -n ${PROJECT} -i l version.txt
 
-.for _clj in ${CLJSRC}
-dist/${_clj}: src/${_clj} ${DISTDIR}
-	shtool install -c src/${_clj} dist/${_clj}
-.endfor
-
-.for _clj in ${GCCLJSRC}
-dist/${_clj:R:R}.class: src/${_clj} ${DISTDIR}
-	java clojure.lang.Script gen-class.clj -- ${DISTDIR} ${_clj}
-.endfor
-
 ${JAR}: doc compile
 	cp README.txt ${DISTDIR}
 	cp LICENSE ${DISTDIR}

File README.txt.in

-     ______________     ________                   ______________________
-     __  ____/__  /___________(_)___  ________________  __/__    |__  __ \
-     _  /    __  /_  __ \____  /_  / / /_  ___/  _ \_  /  __  /| |_  /_/ /
-     / /___  _  / / /_/ /___  / / /_/ /_  /   /  __/  /   _  ___ |  ____/
-     \____/  /_/  \____/___  /  \__,_/ /_/    \___//_/    /_/  |_/_/
-                        /___/
+            ___________________________________            ______
+            __  ____/__  /_____(_)_  ____/__  /_______________  /__
+            _  /    __  /_____  /_  /    __  __ \  _ \  ___/_  //_/
+            / /___  _  / ____  / / /___  _  / / /  __/ /__ _  ,<
+            \____/  /_/  ___  /  \____/  /_/ /_/\___/\___/ /_/|_|
+                         /___/
 
 An implementation of the Test Anything Protocol. It is a simple protocol to
 transfer information from tests to a harness, which in turn extracts the
+;-
+; Copyright 2008 (c) Meikel Brandmeyer.
+; All rights reserved.
+;
+; Permission is hereby granted, free of charge, to any person obtaining a copy
+; of this software and associated documentation files (the "Software"), to deal
+; in the Software without restriction, including without limitation the rights
+; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+; copies of the Software, and to permit persons to whom the Software is
+; furnished to do so, subject to the following conditions:
+;
+; The above copyright notice and this permission notice shall be included in
+; all copies or substantial portions of the Software.
+;
+; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+; THE SOFTWARE.
+
+(binding [*compile-path* "classes"]
+  (compile 'de.kotka.clojurecheck))

File example/com/example/anglediff.clj

+(clojure.core/ns com.example.anglediff)
+
+; See property fail, but tests succeed.
+(defn anglediff
+  "Compute the angular difference between a and b."
+  [a b]
+  (rem (Math/abs (- a b)) 180))
+
+(comment
+; See property and tests succeed.
+(defn anglediff
+  "Compute the angular difference between a and b."
+  [a b]
+  (let [diff (rem (Math/abs (- a b)) 360)]
+    (if (< 180 diff)
+      (- 360 diff)
+      diff)))
+  )

File example/com/example/anglediff/anglediff.clj

-(clojure/ns com.example.anglediff)
-
-; See property fail, but tests succeed.
-(defn anglediff
-  "Compute the angular difference between a and b."
-  [a b]
-  (rem (Math/abs (- a b)) 180))
-
-(comment
-; See property and tests succeed.
-(defn anglediff
-  "Compute the angular difference between a and b."
-  [a b]
-  (let [diff (rem (Math/abs (- a b)) 360)]
-    (if (< 180 diff)
-      (- 360 diff)
-      diff)))
-  )

File example/t/anglediff.t

 exec("java", "clojure.lang.Script", $0) or die "Cannot exec Java!";
 __END__
 )
-(clojure/ns com.example.anglediff.test
+(clojure.core/ns com.example.anglediff.test
   (:use
      com.example.anglediff
-     [de.kotka.tap :only (is let-gen holds? for-all)])
+     [de.kotka.clojurecheck :only (is let-gen holds? for-all)])
   (:require
-     [de.kotka.tap :as tap]))
+     [de.kotka.clojurecheck :as cc]))
 
-(tap/plan 7)
+(cc/plan 7)
 
 (is (= (anglediff 0 0) 0) "zero at zero")
 (is (= (anglediff 90 90) 0) "zero at 90")
     (let [b (+ a (* n 360) d)]
       (is (= (anglediff a b) (Math/abs d)))))
   "anglediff satifies definition of angular diff")
+
+; vim:ft=clojure:

File gen-docs.clj

 ; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
 ; THE SOFTWARE.
 
-(require 'de.kotka.tap)
+(require 'de.kotka.clojurecheck)
 
 (let [c  (proxy [java.util.Comparator] []
            (compare
              (let [as (str a)
                    bs (str b)]
                (. as compareTo bs))))
-      vs (map (fn [[n v]] v) (ns-publics (find-ns 'de.kotka.tap)))]
-  (doseq v (sort c vs)
+      vs (map (fn [[n v]] v) (ns-publics (find-ns 'de.kotka.clojurecheck)))]
+  (doseq [v (sort c vs)]
     (print-doc v)))

File src/de/kotka/clojurecheck.clj

+;-
+; Copyright 2008 (c) Meikel Brandmeyer.
+; All rights reserved.
+;
+; Permission is hereby granted, free of charge, to any person obtaining a copy
+; of this software and associated documentation files (the "Software"), to deal
+; in the Software without restriction, including without limitation the rights
+; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+; copies of the Software, and to permit persons to whom the Software is
+; furnished to do so, subject to the following conditions:
+;
+; The above copyright notice and this permission notice shall be included in
+; all copies or substantial portions of the Software.
+;
+; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+; THE SOFTWARE.
+
+(clojure.core/ns de.kotka.clojurecheck
+  (:use
+     clojure.contrib.def
+     clojure.contrib.gen-interface)
+  (:load
+     "clojurecheck/directives"
+     "clojurecheck/harness"
+     "clojurecheck/infrastructure"
+     "clojurecheck/tests"
+     "clojurecheck/arbitrary"
+     "clojurecheck/combinators"
+     "clojurecheck/generators"))

File src/de/kotka/clojurecheck/arbitrary.clj

+;-
+; Copyright 2008 (c) Meikel Brandmeyer.
+; All rights reserved.
+;
+; Permission is hereby granted, free of charge, to any person obtaining a copy
+; of this software and associated documentation files (the "Software"), to deal
+; in the Software without restriction, including without limitation the rights
+; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+; copies of the Software, and to permit persons to whom the Software is
+; furnished to do so, subject to the following conditions:
+;
+; The above copyright notice and this permission notice shall be included in
+; all copies or substantial portions of the Software.
+;
+; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+; THE SOFTWARE.
+
+(clojure.core/in-ns 'de.kotka.clojurecheck)
+
+(defvar
+  *prng*
+  (new java.util.Random)
+  "The PRNG used to generate the test data.")
+
+(defn with-prng*
+  "Install the given PRNG while running the given thunk. It must conform
+  to the interface of java.util.Random!"
+  [prng thunk]
+  (binding [*prng* prng]
+    (thunk)))
+
+(defmacro with-prng
+  "Install the given PRNG while running the given body. It must conform
+  to the interface of java.util.Random!"
+  [prng & body]
+  `(with-prng* ~prng (fn [] ~@body)))
+
+(defmulti
+  #^{:doc
+  "The arbitrary multimethod defines generators for different types.
+  It takes at least two arguments: the type and a size argument. The
+  type may be a class or keyword defining which value to generator. It
+  is also possible to pass more arguments to the method. However the
+  type will always be the first one, size the last."}
+  arbitrary
+  (fn [x & _] x))
+
+(defmethod arbitrary :default
+  [x size]
+  (x nil size))
+
+(defn- apply-generator
+  [g s]
+  (if (vector? g)
+    (apply arbitrary (conj g s))
+    (arbitrary g s)))
+
+(defn- make-binding-vector
+  [size gen-bindings]
+  (vec (mapcat (fn [[v g]]
+                 [v `((ns-resolve (symbol "de.kotka.clojurecheck")
+                                  (symbol "apply-generator"))
+                        ~g ~size)])
+               (partition 2 gen-bindings))))
+
+(defvar
+  *max-checks*
+  100
+  "The maximum number of iterations, which are done by for-all.")
+
+(defn for-all*
+  "This is the driver for the for-all macro. Should not be called
+  directly."
+  [gen test-fn]
+  (loop [i 0]
+    (let [h     (make-batch-harness)
+          input (gen i)]
+      (binding [*the-harness* h]
+        (try
+          (test-fn input)
+          (catch Exception e
+            (report-result *mode* false nil)
+            (diag (str "Exception was thrown: " e)))))
+      (if (and (< i *max-checks*) (.getResult h))
+        (recur (inc i))
+        [h input]))))
+
+(defmacro for-all
+  "for-all binds the given generators to the given values and runs the
+  body. The body might define any tests (and even a plan) since it is
+  run against its own harness."
+  [gen-bindings & body]
+  (let [size    (gensym "for-all_size__")
+        xs      (take-nth 2 gen-bindings)
+        gen     `(fn [~size]
+                   (let ~(make-binding-vector size gen-bindings)
+                     (hash-map ~@(mapcat (fn [x] `[(quote ~x) ~x]) xs))))
+        test-fn `(fn [~(hash-map :syms (into [] xs))] ~@body)]
+    `(for-all* ~gen ~test-fn)))
+
+(defn holds?*
+  "This is the driver function for the holds? macro and should not be
+  called directly."
+  [prop desc]
+  (let [[h vs] (prop)]
+    (if (.getResult h)
+      (report-result *mode* true desc)
+      (do
+        (report-result *mode* false desc)
+        (diag "Property failed, counter example is:")
+        (doseq [[vr vl] vs]
+          (diag (str "  " vr " => " vl)))
+        (diag "\nDiagnostics were:")
+        (diag (.getDiagnostics h))))))
+
+(defmacro holds?
+  "holds? tests the given property. A property is defined by for-all."
+  [prop & desc]
+  `(holds?* (fn [] ~prop) ~(first desc)))

File src/de/kotka/clojurecheck/combinators.clj

+;-
+; Copyright 2008 (c) Meikel Brandmeyer.
+; All rights reserved.
+;
+; Permission is hereby granted, free of charge, to any person obtaining a copy
+; of this software and associated documentation files (the "Software"), to deal
+; in the Software without restriction, including without limitation the rights
+; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+; copies of the Software, and to permit persons to whom the Software is
+; furnished to do so, subject to the following conditions:
+;
+; The above copyright notice and this permission notice shall be included in
+; all copies or substantial portions of the Software.
+;
+; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+; THE SOFTWARE.
+
+(clojure.core/in-ns 'de.kotka.clojurecheck)
+
+(defmacro let-gen
+  "let-gen creates a new generator, which binds the given generators
+  to the given variables and then executes the body. It is similar to
+  for-all, which is used to define a test case. However the let-gen
+  is not supposed to be run with test cases in the body. The body must
+  not have side effects."
+  [gen-bindings & body]
+  (let [size (gensym "let-gen_size__")]
+    `(fn [_# ~size]
+       (let ~(make-binding-vector size gen-bindings)
+         ~@body))))
+
+(defn unit
+  "unit returns a generator, which always returns the given value."
+  [x]
+  (constantly x))
+
+(defmacro with-size
+  "Although normally not necessary, it is sometimes desirable to have
+  access to the size parameter when building a generator. This can be
+  achieved by the with-size combinator. The body must return a generator.
+
+  Example:
+
+  | => (with-size s (let-gen [x [Integer 0 size]] x))"
+  [sv & body]
+  `(fn [_# size#] (arbitrary ((fn [~sv] ~@body) size#) size#)))
+
+(defn one-of
+  "one-of chooses one of the given generators with equal probability."
+  [& gens]
+  (let [len (dec (count gens))]
+    (let-gen [l [Integer 0 len]
+              v (nth gens l)]
+      v)))
+
+(defn frequency
+  "frequency takes a list of of generators, each prefix with weight.
+  The weights have to sum up to 100. The higher the weight,
+  the more often the following generator is chosen."
+  [& weights-and-gens]
+  (let [weights-and-gens (partition 2 weights-and-gens)
+        weights-and-gens (reduce (fn [w-n-g [w g]]
+                                   (let [p-w (first (peek w-n-g))]
+                                     (conj w-n-g [(+ p-w w) g])))
+                                 [(first weights-and-gens)]
+                                 (rest weights-and-gens))]
+    (let-gen [guess [Integer 1 100]
+              v     (first (drop-while #(< (first %) guess)
+                                       weights-and-gens))]
+      v)))
+
+(defn elements
+  "elements returns a generator, which chooses one of the given values."
+  [& elems]
+  (let [len (dec (count elems))]
+    (let-gen [l [Integer 0 len]]
+      (nth elems l))))
+
+(defn list-of
+  "list-of returns a generator, which generates a list of the given
+  generator."
+  [g]
+  (with-size s
+    (let-gen [l [Integer 0 s]]
+      (reduce (fn [lst _] (conj lst (apply-generator g s))) nil (range l)))))
+
+(defn vector-of
+  "vector-of returns a generator, which generates a vector of the given
+  generators."
+  [g]
+  (let-gen [lst (list-of g)]
+    (into [] lst)))

File src/de/kotka/clojurecheck/directives.clj

+;-
+; Copyright 2008 (c) Meikel Brandmeyer.
+; All rights reserved.
+;
+; Permission is hereby granted, free of charge, to any person obtaining a copy
+; of this software and associated documentation files (the "Software"), to deal
+; in the Software without restriction, including without limitation the rights
+; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+; copies of the Software, and to permit persons to whom the Software is
+; furnished to do so, subject to the following conditions:
+;
+; The above copyright notice and this permission notice shall be included in
+; all copies or substantial portions of the Software.
+;
+; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+; THE SOFTWARE.
+
+(clojure.core/in-ns 'de.kotka.clojurecheck)
+
+(defvar- *mode*        :normal)
+(defvar- *skip-reason* :none)
+
+(defn todo*
+  "This is the driver for the <todo> macro. This function should not
+  be called directly."
+  [body]
+  (binding [*mode* :todo]
+    (body)))
+
+(defmacro todo
+  "Marking unfinished functionality. Wrapping tests in a <todo> call marks the
+  tests with the TODO directive. This information might be used by the
+  harness to provide further hints to the user. Perl's „prove“ utility
+  considers TODO tests to be irrelevant to the whole result of the test
+  script. They should fail however. Succeeding TODO tests are reported by
+  „prove“ in a special way, giving a hint that the TODO status of the test
+  should be revised.
+
+  Example:
+
+  | => (todo
+  |      (ok? (taken-over-the-world) „take over the world“))
+  | not ok 1 # TODO take over the world"
+  [& body]
+  `(todo* (fn [] ~@body)))
+
+(defn skip*
+  "This is the driver for the <skip> macro. This function should not
+  be called directly."
+  [reason body]
+  (binding [*mode*        :skip
+            *skip-reason* reason]
+     (body)))
+
+(defmacro skip
+  "Skip certain tests. Sometimes certain functionality is disabled, eg. when
+  it is not applicable to the platform currently running on or when the
+  functionality is disabled on purpose. The tests wrapped in the <skip> call
+  are actually not run at all, but reported to succeed and marked with the
+  SKIP directive and the given reason.
+
+  Note:
+
+  Code between tests *is* run!
+
+  Example:
+
+  | => (skip „frobnicator library not available“
+  |      (ok? (frobnicator/do-frobnicate foo) „foo is frobnicatable“))
+  | ok 1 # SKIP frobnicator library not available
+
+  The call to „do-frobnicate“ is actually not done. The test is always
+  reported to succeed marked with the SKIP directive and the reason, why the
+  test was skipped."
+  [reason & body]
+  `(skip* ~reason (fn [] ~@body)))
+
+(defn skip-if*
+  "This is the driver for the <skip-if> macro. This function should not
+  be called directly."
+  [t reason body]
+  (if t
+    (skip* reason body)
+    (body)))
+
+(defmacro skip-if
+  "Conditionally skip tests. In case the guard tests evaluates to „true“ the
+  given tests are run in <skip> call with the given reason. Otherwise the
+  tests are run normally.
+
+  Example:
+
+  | => (skip-if (< (flogiston-pressure) 100) „flogiston pressure too low“
+  |      (ok? (inject-flogiston) „flogiston injection works“))"
+  [t reason & body]
+  `(skip-if* ~t ~reason (fn [] ~@body)))
+
+(when *compile-files*
+  (gen-and-save-class *compile-path* 'de.kotka.clojurecheck.FatalTestError
+    :extends Exception)
+  (gen-and-load-class 'de.kotka.clojurecheck.FatalTestError
+    :extends Exception))
+
+(import '(de.kotka.clojurecheck FatalTestError))
+
+(defvar- *fatal* false)
+
+(defn fatal*
+  "Executes the thunk in fatal context. That is a failing test will
+  abort the thunk immediately. See also „fatal“ macro."
+  [thunk]
+  (binding [*fatal* true]
+    (try
+      (thunk)
+      (catch FatalTestError e `test-failed))))
+
+(defmacro fatal
+  "Abort on failing tests. In case one has several tests, which depend on
+  each other, one can specify a fatal block around the tests in question.
+  Should a test fail, the rest of the tests of the block are skipped.
+
+  Example:
+
+  | => (fatal
+  |      (ok? (save-flogistion-pressure?) „flogiston pressure is save“)
+  |      (is? (open-reactor-door) :opened „reactor door opened“))
+  | not ok 1 - flogiston pressure is save
+
+  Note: the second test is not executed!"
+  [& body]
+  `(fatal* (fn [] ~@body)))

File src/de/kotka/clojurecheck/generators.clj

+;-
+; Copyright 2008 (c) Meikel Brandmeyer.
+; All rights reserved.
+;
+; Permission is hereby granted, free of charge, to any person obtaining a copy
+; of this software and associated documentation files (the "Software"), to deal
+; in the Software without restriction, including without limitation the rights
+; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+; copies of the Software, and to permit persons to whom the Software is
+; furnished to do so, subject to the following conditions:
+;
+; The above copyright notice and this permission notice shall be included in
+; all copies or substantial portions of the Software.
+;
+; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+; THE SOFTWARE.
+
+(clojure.core/in-ns 'de.kotka.clojurecheck)
+
+(defmethod arbitrary Double
+  ([_ mn mx _]
+   (+ mn (* (- mx mn) (.nextDouble *prng*))))
+  ([_ size]
+   (arbitrary Double (- size) size nil)))
+
+(defmethod arbitrary Integer
+  ([_ mn mx _]
+   (int (Math/round (arbitrary Double mn mx nil))))
+  ([_ size]
+   (arbitrary Integer (- size) size nil)))
+
+(defmethod arbitrary Character
+  ([_ source _]
+   (.charAt source (arbitrary Integer 0 (dec (.length source)) nil)))
+  ([_ _]
+   (char (arbitrary Integer 32 255 nil))))
+
+(defmethod arbitrary Boolean
+  [_ _]
+  (arbitrary (elements true false) nil))

File src/de/kotka/clojurecheck/harness.clj

+;-
+; Copyright 2008 (c) Meikel Brandmeyer.
+; All rights reserved.
+;
+; Permission is hereby granted, free of charge, to any person obtaining a copy
+; of this software and associated documentation files (the "Software"), to deal
+; in the Software without restriction, including without limitation the rights
+; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+; copies of the Software, and to permit persons to whom the Software is
+; furnished to do so, subject to the following conditions:
+;
+; The above copyright notice and this permission notice shall be included in
+; all copies or substantial portions of the Software.
+;
+; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+; THE SOFTWARE.
+
+(clojure.core/in-ns 'de.kotka.clojurecheck)
+
+(when *compile-files*
+  (gen-and-save-interface *compile-path* 'de.kotka.clojurecheck.IHarness []
+                          ['plan [Integer] Object]
+                          ['diag [String] Object]
+                          ['bailOut [String] Object]
+                          ['reportResult [Object Boolean String] Object]
+                          ['getResult [] Object]
+                          ['getDiagnostics [] String]))
+
+(import '(de.kotka.clojurecheck IHarness))
+
+(defn make-standard-harness
+  "make-standard-harness creates a new standard harness."
+  []
+  (let [current-test (ref 1)]
+    (proxy [IHarness] []
+      (plan
+        [count]
+        (print "1..")
+        (print count)
+        (newline)
+        (flush))
+
+      (diag
+        [msg]
+        (doseq [l (.split msg "\n")]
+          (print "# ")
+          (print l)
+          (newline)
+          (flush)))
+
+      (bailOut
+        [msg]
+        (print "Bail out!")
+        (when msg
+          (print " ")
+          (print msg))
+        (newline)
+        (flush)
+        (.exit java.lang.System 1))
+
+      (reportResult
+        [m t desc]
+        (if t
+          (print "ok ")
+          (print "not ok "))
+        (print (dosync
+                 (let [c @current-test]
+                   (alter current-test inc)
+                   c)))
+        (cond
+          (= m :todo) (print " # TODO")
+          (= m :skip) (print " # SKIP"))
+        (when-not (nil? desc)
+          (print " - ")
+          (print desc))
+        (newline)
+        (flush)))))
+
+(defn make-batch-harness
+  "Create a new batch harness suitable to run recursive tests. So one
+  can specify tests, which themselves contain other tests."
+  []
+  (let [our-plan     (ref :noplan)
+        current-test (ref 1)
+        failed-test  (ref false)
+        diagnostics  (ref "")]
+    (proxy [IHarness] []
+      (plan
+        [count]
+        (dosync (ref-set our-plan count)))
+
+      (diag
+        [msg]
+        (dosync (commute diagnostics #(str %1 \newline %2) msg)))
+
+      (bailOut
+        [msg]
+        (dosync (commute diagnostics #(str %1 "Bailing out!"
+                                           (when msg (str " " msg)))))
+        (throw (new FatalTestError)))
+
+      (reportResult
+        [m t desc]
+        (when-not t
+          (dosync (ref-set failed-test true)))
+        (dosync (alter current-test inc)))
+
+      (getResult
+        []
+        (and (or (= @our-plan :noplan)
+                 (= @our-plan (dec @current-test)))
+             (not @failed-test)))
+
+      (getDiagnostics
+        []
+        @diagnostics))))
+
+(defvar *the-harness*
+  (make-standard-harness)
+  "The handlers. This actually implements the TAP protocol itself, but may be
+  re-bound via binding to enable different behaviour.")
+
+(defn with-harness*
+  [harness thunk]
+  (binding [*the-harness* harness]
+    (thunk)
+    harness))
+
+(defmacro with-harness
+  [harness & body]
+  `(with-harness* ~harness (fn [] ~@body)))

File src/de/kotka/clojurecheck/infrastructure.clj

+;-
+; Copyright 2008 (c) Meikel Brandmeyer.
+; All rights reserved.
+;
+; Permission is hereby granted, free of charge, to any person obtaining a copy
+; of this software and associated documentation files (the "Software"), to deal
+; in the Software without restriction, including without limitation the rights
+; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+; copies of the Software, and to permit persons to whom the Software is
+; furnished to do so, subject to the following conditions:
+;
+; The above copyright notice and this permission notice shall be included in
+; all copies or substantial portions of the Software.
+;
+; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+; THE SOFTWARE.
+
+(clojure.core/in-ns 'de.kotka.clojurecheck)
+
+(defn plan
+  "Print the test plan. Ie. the number of tests you intend to run. This gives
+  the harness a chance to see, whether the tests ran completely. It is not
+  strictly necessary to provide a plan. However it is strongly encouraged to
+  do so.
+
+  Example:
+
+  | => (plan 10)
+  | 1..10"
+  [count]
+  (. *the-harness* plan count))
+
+(defn diag
+  "Print diagnostics. Sometimes a test script wants to provide diagnostic
+  information to the user. Eg. <is?> and friends provide information about
+  the deviation from the expected outcome to the user. <diag> is a utility
+  which takes away the burden of the special formating of such information
+  from the test script.
+
+  Example:
+
+  | => (diag „flogiston pressure dropping rapidly“)
+  | # flogiston pressure dropping rapidly"
+  [msg]
+  (. *the-harness* diag msg))
+
+(defn bail-out
+  "Bail out of the test process. Sometimes the system or the environment is so
+  messed up, that further testing doesn't make sense. Then <bail-out> may be
+  used to stop further testing immediately. Optionally a reason about the
+  bailing out, may be given to provide to the user, why the testing stopped.
+
+  Example:
+
+  | => (bail-out)
+  | Bail out!
+  | => (bail-out „flogiston pressure too low“)
+  | Bail out! flogiston pressure too low"
+  ([]    (. *the-harness* bailOut nil))
+  ([msg] (. *the-harness* bailOut msg)))
+
+(defn- report-result
+  [m t d]
+  (. *the-harness* reportResult m t d))
+
+(defn test-driver
+  "Driver function for the tests. This function should only be called, when
+  defining new test methods. The driver receives the actual form under test
+  as a closure as well as it's quoted form. Similarly the expected value is
+  transferred. The following description is optional and might be „nil“.
+  Finally two callbacks to compare the actual result against the expected
+  one and to print a diagnostic message in case of failure.
+
+  In case an exception is thrown it is caught and reported via a diagnostic
+  message to the user. The test fails in that case.
+
+  Example:
+
+  | => (defmethod is* 'in-intervall?
+  |      [t desc]
+  |      (let [[min max body] (rest t)]
+  |        `(let [min# ~min
+  |               max# ~max]
+  |           (test-driver (fn [] ~body)
+  |                        (quote ~body)
+  |                        (fn [] nil)   ; Don't need „expected result“.
+  |                        ~desc         ; Might be „nil“.
+  |                        (fn [expected# actual#]
+  |                          (<= min# actual# max#))
+  |                        (fn [expected# actual# result#]
+  |                          (diag (str „Expected:      “ actual#))
+  |                          (diag (str „to be between: “ min#))
+  |                          (diag (str „and:           “ max#))
+  |                          (diag (str „but was:       “ result#)))))))
+  |
+  | => (is (in-intervall? 100 150 (flogiston-pressure)) „flogiston pressure ok“)
+  | not ok 1 - flogiston pressure ok
+  | # Expected:      (flogiston-pressure)
+  | # to be between: 100
+  | # and:           150
+  | # but was:       58"
+  [actual qactual exp desc pred diagnose]
+  (if (= *mode* :skip)
+    (report-result *mode* true *skip-reason*)
+    (try
+      (let [e (exp)
+            a (actual)
+            r (pred e a)]
+        (report-result *mode* r desc)
+        (when-not r
+          (let [es (pr-str e)
+                as (pr-str qactual)
+                rs (pr-str a)]
+            (diagnose es as rs))
+          (when *fatal*
+            (throw (new FatalTestError))))
+        a)
+      (catch FatalTestError e
+        (throw e))
+      (catch Exception e
+        (report-result *mode* false desc)
+        (diag (str "Exception was thrown: " e))
+        (if *fatal*
+          (throw (new FatalTestError))
+          `test-failed)))))

File src/de/kotka/clojurecheck/tests.clj

+;-
+; Copyright 2008 (c) Meikel Brandmeyer.
+; All rights reserved.
+;
+; Permission is hereby granted, free of charge, to any person obtaining a copy
+; of this software and associated documentation files (the "Software"), to deal
+; in the Software without restriction, including without limitation the rights
+; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+; copies of the Software, and to permit persons to whom the Software is
+; furnished to do so, subject to the following conditions:
+;
+; The above copyright notice and this permission notice shall be included in
+; all copies or substantial portions of the Software.
+;
+; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+; THE SOFTWARE.
+
+(clojure.core/in-ns 'de.kotka.clojurecheck)
+
+(defn- test-tag [t] (if (seq? t) (first t) t))
+(defn- actual   [t] (second t))
+(defn- expected [t] (second (rest t)))
+
+(defmulti
+  #^{:doc
+  "is* is the driver for the is macro and should not be called directly."}
+  is*
+  (fn [x & _] (test-tag x)))
+
+(defmethod is* :default
+  [t desc]
+  `(test-driver (fn [] ~t)
+                (quote ~t)
+                (fn [] nil)
+                ~desc
+                (fn [e# a#] a#)
+                (fn [e# a# r#]
+                  (diag (.. "Expected: "
+                            (concat a#)
+                            (concat " to be true"))))))
+
+(defmethod is* '=
+  [t desc]
+  `(test-driver (fn [] ~(actual t))
+                (quote ~(actual t))
+                (fn [] ~(expected t))
+                ~desc
+                (fn [e# a#] (= e# a#))
+                (fn [e# a# r#]
+                  (diag (.concat "Expected: " a#))
+                  (diag (.concat "to be:    " e#))
+                  (diag (.concat "but was:  " r#)))))
+
+(defmethod is* 'not=
+  [t desc]
+  `(test-driver (fn [] ~(actual t))
+                (quote ~(actual t))
+                (fn [] ~(expected t))
+                ~desc
+                (fn [e# a#] (not= e# a#))
+                (fn [e# a# r#]
+                  (diag (.concat "Expected:  " a#))
+                  (diag (.concat "not to be: " e#)))))
+
+(defmethod is* 'like?
+  [t desc]
+  `(test-driver (fn [] ~(actual t))
+                (quote ~(actual t))
+                (fn [] ~(expected t))
+                ~desc
+                (fn [e# a#] (not (nil? (re-find e# a#))))
+                (fn [e# a# r#]
+                  (diag (.concat "Expected: " a#))
+                  (diag (.concat "to match: " e#)))))
+
+(defmethod is* 'unlike?
+  [t desc]
+  `(test-driver (fn [] ~(actual t))
+                (quote ~(actual t))
+                (fn [] ~(expected t))
+                ~desc
+                (fn [e# a#] (nil? (re-find e# a#)))
+                (fn [e# a# r#]
+                  (diag (.concat "Expected:     " a#))
+                  (diag (.concat "not to match: " e#))
+                  (diag (.concat "string was:   " r#)))))
+
+(defmethod is* 'throwing?
+  [t desc]
+  `(test-driver (fn []
+                  (try
+                    (do
+                      ~(second (rest t))
+                      false)
+                    (catch ~(second t) e#
+                      true)))
+                (quote ~(second (rest t)))
+                (fn [] ~(second t))
+                ~desc
+                (fn [e# a#] a#)
+                (fn [e# a# r#]
+                  (diag (.concat "Expected: " a#))
+                  (diag (.concat "to throw: " e#)))))
+
+(defmethod is* 'running?
+  [t desc]
+  `(test-driver (fn [] ~(second t))
+                (quote ~(second t))
+                (fn [] nil)
+                ~desc
+                (fn [e# a#] true)
+                (fn [e# a# r#]
+                  (diag (.concat "Expected " a#
+                                 " to run through w/o exception.")))))
+
+(defmacro is
+  "is* runs the given comparison and reports any error or Exception. Based on
+  the predicate used further diagnostic information is provided. See below
+  for a list of supported predicates and corresponding examples.
+
+  Supported Predicates:
+
+    :default  - a simply yes/no test executing the provided form, which
+                should evaluate to false in case the test fails
+    =         - compare the actual vs. the expected value using =.
+    not=      - same but with not=
+    like?     - use re-find to check whether the given string matches
+                the given regular expression
+    unlike?   - use re-find to check whether the given string does
+                not match the given regular expression
+    throwing? - check whether the form throws the given Exception
+    running?  - check whether the form runs w/o throwing an Exception
+
+  Examples:
+
+  | => (is (pressure-save? (flogiston-pressure)) „flogiston pressure is save“)
+  | not ok 1 - flogiston pressure is save
+  | # Expected: (pressure-save? (flogiston-pressure)) to be true
+
+  | => (is (= (flogiston-pressure) *normal-flogiston-pressure*)
+  |      „flogiston pressure is normal“)
+  | not ok 2 - „flogiston pressure is normal“
+  | # Expected: (flogiston-pressure)
+  | # to be:    125
+  | # but was:  58
+
+  | => (def flogiston-reactor (is (running? (new FlogistonReactor))
+  |                               „created new flogiston reactor“))
+  | ok 3 - created new flogiston reactor"
+  [t & desc]
+  (is* t (first desc)))

File src/de/kotka/tap/FatalTestError.gen.clj

-;-
-; Copyright 2008 (c) Meikel Brandmeyer.
-; All rights reserved.
-;
-; Permission is hereby granted, free of charge, to any person obtaining a copy
-; of this software and associated documentation files (the "Software"), to deal
-; in the Software without restriction, including without limitation the rights
-; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-; copies of the Software, and to permit persons to whom the Software is
-; furnished to do so, subject to the following conditions:
-;
-; The above copyright notice and this permission notice shall be included in
-; all copies or substantial portions of the Software.
-;
-; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-; THE SOFTWARE.
-
-(gen-and-save-class *builddir* 'de.kotka.tap.FatalTestError :extends Exception)

File src/de/kotka/tap/IHarness.gen.clj

-;-
-; Copyright 2008 (c) Meikel Brandmeyer.
-; All rights reserved.
-;
-; Permission is hereby granted, free of charge, to any person obtaining a copy
-; of this software and associated documentation files (the "Software"), to deal
-; in the Software without restriction, including without limitation the rights
-; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-; copies of the Software, and to permit persons to whom the Software is
-; furnished to do so, subject to the following conditions:
-;
-; The above copyright notice and this permission notice shall be included in
-; all copies or substantial portions of the Software.
-;
-; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-; THE SOFTWARE.
-
-(use 'clojure.contrib.gen-interface)
-
-(gen-and-save-interface *builddir* 'de.kotka.tap.IHarness []
-  ['plan [Integer] Object]
-  ['diag [String] Object]
-  ['bailOut [String] Object]
-  ['reportResult [Object Boolean String] Object]
-  ['getResult [] Object]
-  ['getDiagnostics [] String])

File src/de/kotka/tap/clojurecheck/arbitrary.clj

-;-
-; Copyright 2008 (c) Meikel Brandmeyer.
-; All rights reserved.
-;
-; Permission is hereby granted, free of charge, to any person obtaining a copy
-; of this software and associated documentation files (the "Software"), to deal
-; in the Software without restriction, including without limitation the rights
-; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-; copies of the Software, and to permit persons to whom the Software is
-; furnished to do so, subject to the following conditions:
-;
-; The above copyright notice and this permission notice shall be included in
-; all copies or substantial portions of the Software.
-;
-; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-; THE SOFTWARE.
-
-(clojure/in-ns 'de.kotka.tap)
-
-(defvar
-  *prng*
-  (new java.util.Random)
-  "The PRNG used to generate the test data.")
-
-(defn with-prng*
-  "Install the given PRNG while running the given thunk. It must conform
-  to the interface of java.util.Random!"
-  [prng thunk]
-  (binding [*prng* prng]
-    (thunk)))
-
-(defmacro with-prng
-  "Install the given PRNG while running the given body. It must conform
-  to the interface of java.util.Random!"
-  [prng & body]
-  `(with-prng* ~prng (fn [] ~@body)))
-
-(defmulti
-  #^{:doc
-  "The arbitrary multimethod defines generators for different types.
-  It takes at least two arguments: the type and a size argument. The
-  type may be a class or keyword defining which value to generator. It
-  is also possible to pass more arguments to the method. However the
-  type will always be the first one, size the last."}
-  arbitrary
-  (fn [x & _] x))
-
-(defmethod arbitrary :default
-  [x size]
-  (x nil size))
-
-(defn- apply-generator
-  [g s]
-  (if (vector? g)
-    (apply arbitrary (conj g s))
-    (arbitrary g s)))
-
-(defn- make-binding-vector
-  [size gen-bindings]
-  (vec (mapcat (fn [[v g]]
-                 [v `((ns-resolve (symbol "de.kotka.tap")
-                                  (symbol "apply-generator"))
-                        ~g ~size)])
-               (partition 2 gen-bindings))))
-
-(defvar
-  *max-checks*
-  100
-  "The maximum number of iterations, which are done by for-all.")
-
-(defn for-all*
-  "This is the driver for the for-all macro. Should not be called
-  directly."
-  [gen test-fn]
-  (loop [i 0]
-    (let [h     (make-batch-harness)
-          input (gen i)]
-      (binding [*the-harness* h]
-        (try
-          (test-fn input)
-          (catch Exception e
-            (report-result *mode* false nil)
-            (diag (str "Exception was thrown: " e)))))
-      (if (and (< i *max-checks*) (.getResult h))
-        (recur (inc i))
-        [h input]))))
-
-(defmacro for-all
-  "for-all binds the given generators to the given values and runs the
-  body. The body might define any tests (and even a plan) since it is
-  run against its own harness."
-  [gen-bindings & body]
-  (let [size    (gensym "for-all_size__")
-        xs      (take-nth 2 gen-bindings)
-        gen     `(fn [~size]
-                   (let ~(make-binding-vector size gen-bindings)
-                     (hash-map ~@(mapcat (fn [x] `[(quote ~x) ~x]) xs))))
-        test-fn `(fn [~(hash-map :syms (into [] xs))] ~@body)]
-    `(for-all* ~gen ~test-fn)))
-
-(defn holds?*
-  "This is the driver function for the holds? macro and should not be
-  called directly."
-  [prop desc]
-  (let [[h vs] (prop)]
-    (if (.getResult h)
-      (report-result *mode* true desc)
-      (do
-        (report-result *mode* false desc)
-        (diag "Property failed, counter example is:")
-        (doseq [vr vl] vs
-          (diag (str "  " vr " => " vl)))
-        (diag "\nDiagnostics were:")
-        (diag (.getDiagnostics h))))))
-
-(defmacro holds?
-  "holds? tests the given property. A property is defined by for-all."
-  [prop & desc]
-  `(holds?* (fn [] ~prop) ~(first desc)))

File src/de/kotka/tap/clojurecheck/combinators.clj

-;-
-; Copyright 2008 (c) Meikel Brandmeyer.
-; All rights reserved.
-;
-; Permission is hereby granted, free of charge, to any person obtaining a copy
-; of this software and associated documentation files (the "Software"), to deal
-; in the Software without restriction, including without limitation the rights
-; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-; copies of the Software, and to permit persons to whom the Software is
-; furnished to do so, subject to the following conditions:
-;
-; The above copyright notice and this permission notice shall be included in
-; all copies or substantial portions of the Software.
-;
-; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-; THE SOFTWARE.
-
-(clojure/in-ns 'de.kotka.tap)
-
-(defmacro let-gen
-  "let-gen creates a new generator, which binds the given generators
-  to the given variables and then executes the body. It is similar to
-  for-all, which is used to define a test case. However the let-gen
-  is not supposed to be run with test cases in the body. The body must
-  not have side effects."
-  [gen-bindings & body]
-  (let [size (gensym "let-gen_size__")]
-    `(fn [_# ~size]
-       (let ~(make-binding-vector size gen-bindings)
-         ~@body))))
-
-(defn unit
-  "unit returns a generator, which always returns the given value."
-  [x]
-  (constantly x))
-
-(defmacro with-size
-  "Although normally not necessary, it is sometimes desirable to have
-  access to the size parameter when building a generator. This can be
-  achieved by the with-size combinator. The body must return a generator.
-
-  Example:
-
-  | => (with-size s (let-gen [x [Integer 0 size]] x))"
-  [sv & body]
-  `(fn [_# size#] (arbitrary ((fn [~sv] ~@body) size#) size#)))
-
-(defn one-of
-  "one-of chooses one of the given generators with equal probability."
-  [& gens]
-  (let [len (dec (count gens))]
-    (let-gen [l [Integer 0 len]
-              v (nth gens l)]
-      v)))
-
-(defn frequency
-  "frequency takes a list of of generators, each prefix with weight.
-  The weights have to sum up to 100. The higher the weight,
-  the more often the following generator is chosen."
-  [& weights-and-gens]
-  (let [weights-and-gens (partition 2 weights-and-gens)
-        weights-and-gens (reduce (fn [w-n-g [w g]]
-                                   (let [p-w (first (peek w-n-g))]
-                                     (conj w-n-g [(+ p-w w) g])))
-                                 [(first weights-and-gens)]
-                                 (rest weights-and-gens))]
-    (let-gen [guess [Integer 1 100]
-              v     (first (drop-while #(< (first %) guess)
-                                       weights-and-gens))]
-      v)))
-
-(defn elements
-  "elements returns a generator, which chooses one of the given values."
-  [& elems]
-  (let [len (dec (count elems))]
-    (let-gen [l [Integer 0 len]]
-      (nth elems l))))
-
-(defn list-of
-  "list-of returns a generator, which generates a list of the given
-  generator."
-  [g]
-  (with-size s
-    (let-gen [l [Integer 0 s]]
-      (reduce (fn [lst _] (conj lst (apply-generator g s))) nil (range l)))))
-
-(defn vector-of
-  "vector-of returns a generator, which generates a vector of the given
-  generators."
-  [g]
-  (let-gen [lst (list-of g)]
-    (into [] lst)))

File src/de/kotka/tap/clojurecheck/generators.clj

-;-
-; Copyright 2008 (c) Meikel Brandmeyer.
-; All rights reserved.
-;
-; Permission is hereby granted, free of charge, to any person obtaining a copy
-; of this software and associated documentation files (the "Software"), to deal
-; in the Software without restriction, including without limitation the rights
-; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-; copies of the Software, and to permit persons to whom the Software is
-; furnished to do so, subject to the following conditions:
-;
-; The above copyright notice and this permission notice shall be included in
-; all copies or substantial portions of the Software.
-;
-; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-; THE SOFTWARE.
-
-(clojure/in-ns 'de.kotka.tap)
-
-(defmethod arbitrary Double
-  ([_ mn mx _]
-   (+ mn (* (- mx mn) (.nextDouble *prng*))))
-  ([_ size]
-   (arbitrary Double (- size) size nil)))
-
-(defmethod arbitrary Integer
-  ([_ mn mx _]
-   (int (Math/round (arbitrary Double mn mx nil))))
-  ([_ size]
-   (arbitrary Integer (- size) size nil)))
-
-(defmethod arbitrary Character
-  ([_ source _]
-   (.charAt source (arbitrary Integer 0 (dec (.length source)) nil)))
-  ([_ _]
-   (char (arbitrary Integer 32 255 nil))))
-
-(defmethod arbitrary Boolean
-  [_ _]
-  (arbitrary (elements true false) nil))

File src/de/kotka/tap/directives.clj

-;-
-; Copyright 2008 (c) Meikel Brandmeyer.
-; All rights reserved.
-;
-; Permission is hereby granted, free of charge, to any person obtaining a copy
-; of this software and associated documentation files (the "Software"), to deal
-; in the Software without restriction, including without limitation the rights
-; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-; copies of the Software, and to permit persons to whom the Software is
-; furnished to do so, subject to the following conditions:
-;
-; The above copyright notice and this permission notice shall be included in
-; all copies or substantial portions of the Software.
-;
-; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-; THE SOFTWARE.
-
-(clojure/in-ns 'de.kotka.tap)
-
-(defvar- *mode*        :normal)
-(defvar- *skip-reason* :none)
-
-(defn todo*
-  "This is the driver for the <todo> macro. This function should not
-  be called directly."
-  [body]
-  (binding [*mode* :todo]
-    (body)))
-
-(defmacro todo
-  "Marking unfinished functionality. Wrapping tests in a <todo> call marks the
-  tests with the TODO directive. This information might be used by the
-  harness to provide further hints to the user. Perl's „prove“ utility
-  considers TODO tests to be irrelevant to the whole result of the test
-  script. They should fail however. Succeeding TODO tests are reported by
-  „prove“ in a special way, giving a hint that the TODO status of the test
-  should be revised.
-
-  Example:
-
-  | => (todo
-  |      (ok? (taken-over-the-world) „take over the world“))
-  | not ok 1 # TODO take over the world"
-  [& body]
-  `(todo* (fn [] ~@body)))
-
-(defn skip*
-  "This is the driver for the <skip> macro. This function should not
-  be called directly."
-  [reason body]
-  (binding [*mode*        :skip
-            *skip-reason* reason]
-     (body)))
-
-(defmacro skip
-  "Skip certain tests. Sometimes certain functionality is disabled, eg. when
-  it is not applicable to the platform currently running on or when the
-  functionality is disabled on purpose. The tests wrapped in the <skip> call
-  are actually not run at all, but reported to succeed and marked with the
-  SKIP directive and the given reason.
-
-  Note:
-
-  Code between tests *is* run!
-
-  Example:
-
-  | => (skip „frobnicator library not available“
-  |      (ok? (frobnicator/do-frobnicate foo) „foo is frobnicatable“))
-  | ok 1 # SKIP frobnicator library not available
-
-  The call to „do-frobnicate“ is actually not done. The test is always
-  reported to succeed marked with the SKIP directive and the reason, why the
-  test was skipped."
-  [reason & body]
-  `(skip* ~reason (fn [] ~@body)))
-
-(defn skip-if*
-  "This is the driver for the <skip-if> macro. This function should not
-  be called directly."
-  [t reason body]
-  (if t
-    (skip* reason body)
-    (body)))
-
-(defmacro skip-if
-  "Conditionally skip tests. In case the guard tests evaluates to „true“ the
-  given tests are run in <skip> call with the given reason. Otherwise the
-  tests are run normally.
-
-  Example:
-
-  | => (skip-if (< (flogiston-pressure) 100) „flogiston pressure too low“
-  |      (ok? (inject-flogiston) „flogiston injection works“))"
-  [t reason & body]
-  `(skip-if* ~t ~reason (fn [] ~@body)))
-
-(defvar- *fatal* false)
-
-(defn fatal*
-  "Executes the thunk in fatal context. That is a failing test will
-  abort the thunk immediately. See also „fatal“ macro."
-  [thunk]
-  (binding [*fatal* true]
-    (try
-      (thunk)
-      (catch FatalTestError e `test-failed))))
-
-(defmacro fatal
-  "Abort on failing tests. In case one has several tests, which depend on
-  each other, one can specify a fatal block around the tests in question.
-  Should a test fail, the rest of the tests of the block are skipped.
-
-  Example:
-
-  | => (fatal
-  |      (ok? (save-flogistion-pressure?) „flogiston pressure is save“)
-  |      (is? (open-reactor-door) :opened „reactor door opened“))
-  | not ok 1 - flogiston pressure is save
-
-  Note: the second test is not executed!"
-  [& body]
-  `(fatal* (fn [] ~@body)))

File src/de/kotka/tap/harness.clj

-;-
-; Copyright 2008 (c) Meikel Brandmeyer.
-; All rights reserved.
-;
-; Permission is hereby granted, free of charge, to any person obtaining a copy
-; of this software and associated documentation files (the "Software"), to deal
-; in the Software without restriction, including without limitation the rights
-; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-; copies of the Software, and to permit persons to whom the Software is
-; furnished to do so, subject to the following conditions:
-;
-; The above copyright notice and this permission notice shall be included in
-; all copies or substantial portions of the Software.
-;
-; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-; THE SOFTWARE.
-
-(clojure/in-ns 'de.kotka.tap)
-
-(defn make-standard-harness
-  "make-standard-harness creates a new standard harness."
-  []
-  (let [current-test (ref 1)]
-    (proxy [IHarness] []
-      (plan
-        [count]
-        (print "1..")
-        (print count)
-        (newline)
-        (flush))
-
-      (diag
-        [msg]
-        (doseq l (.split msg "\n")
-          (print "# ")
-          (print l)
-          (newline)
-          (flush)))
-
-      (bailOut
-        [msg]
-        (print "Bail out!")
-        (when msg
-          (print " ")
-          (print msg))
-        (newline)
-        (flush)
-        (.exit java.lang.System 1))
-
-      (reportResult
-        [m t desc]
-        (if t
-          (print "ok ")
-          (print "not ok "))
-        (print (dosync
-                 (let [c @current-test]
-                   (alter current-test inc)
-                   c)))
-        (cond
-          (= m :todo) (print " # TODO")
-          (= m :skip) (print " # SKIP"))
-        (when-not (nil? desc)
-          (print " - ")
-          (print desc))
-        (newline)
-        (flush)))))
-
-(defn make-batch-harness
-  "Create a new batch harness suitable to run recursive tests. So one
-  can specify tests, which themselves contain other tests."
-  []
-  (let [our-plan     (ref :noplan)
-        current-test (ref 1)
-        failed-test  (ref false)
-        diagnostics  (ref "")]
-    (proxy [IHarness] []
-      (plan
-        [count]
-        (dosync (ref-set our-plan count)))
-
-      (diag
-        [msg]
-        (dosync (commute diagnostics #(str %1 \newline %2) msg)))
-
-      (bailOut
-        [msg]
-        (dosync (commute diagnostics #(str %1 "Bailing out!"
-                                           (when msg (str " " msg)))))
-        (throw (new de.kotka.tap.FatalTestError)))
-
-      (reportResult
-        [m t desc]
-        (when-not t
-          (dosync (ref-set failed-test true)))
-        (dosync (alter current-test inc)))
-
-      (getResult
-        []
-        (and (or (= @our-plan :noplan)
-                 (= @our-plan (dec @current-test)))
-             (not @failed-test)))
-
-      (getDiagnostics
-        []
-        @diagnostics))))
-
-(defvar *the-harness*
-  (make-standard-harness)
-  "The handlers. This actually implements the TAP protocol itself, but may be
-  re-bound via binding to enable different behaviour.")
-
-(defn with-harness*
-  [harness thunk]
-  (binding [*the-harness* harness]
-    (thunk)
-    harness))
-
-(defmacro with-harness
-  [harness & body]
-  `(with-harness* ~harness (fn [] ~@body)))

File src/de/kotka/tap/infrastructure.clj

-;-
-; Copyright 2008 (c) Meikel Brandmeyer.
-; All rights reserved.
-;
-; Permission is hereby granted, free of charge, to any person obtaining a copy
-; of this software and associated documentation files (the "Software"), to deal
-; in the Software without restriction, including without limitation the rights
-; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-; copies of the Software, and to permit persons to whom the Software is
-; furnished to do so, subject to the following conditions:
-;
-; The above copyright notice and this permission notice shall be included in
-; all copies or substantial portions of the Software.
-;
-; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-; THE SOFTWARE.
-
-(clojure/in-ns 'de.kotka.tap)
-
-(defn plan
-  "Print the test plan. Ie. the number of tests you intend to run. This gives
-  the harness a chance to see, whether the tests ran completely. It is not
-  strictly necessary to provide a plan. However it is strongly encouraged to
-  do so.
-
-  Example:
-
-  | => (plan 10)
-  | 1..10"
-  [count]
-  (. *the-harness* plan count))
-
-(defn diag
-  "Print diagnostics. Sometimes a test script wants to provide diagnostic
-  information to the user. Eg. <is?> and friends provide information about
-  the deviation from the expected outcome to the user. <diag> is a utility
-  which takes away the burden of the special formating of such information
-  from the test script.
-
-  Example:
-
-  | => (diag „flogiston pressure dropping rapidly“)
-  | # flogiston pressure dropping rapidly"
-  [msg]
-  (. *the-harness* diag msg))
-
-(defn bail-out
-  "Bail out of the test process. Sometimes the system or the environment is so
-  messed up, that further testing doesn't make sense. Then <bail-out> may be
-  used to stop further testing immediately. Optionally a reason about the
-  bailing out, may be given to provide to the user, why the testing stopped.
-
-  Example:
-
-  | => (bail-out)
-  | Bail out!
-  | => (bail-out „flogiston pressure too low“)
-  | Bail out! flogiston pressure too low"
-  ([]    (. *the-harness* bailOut nil))
-  ([msg] (. *the-harness* bailOut msg)))
-
-(defn- report-result
-  [m t d]
-  (. *the-harness* reportResult m t d))
-
-(defn test-driver
-  "Driver function for the tests. This function should only be called, when
-  defining new test methods. The driver receives the actual form under test
-  as a closure as well as it's quoted form. Similarly the expected value is
-  transferred. The following description is optional and might be „nil“.
-  Finally two callbacks to compare the actual result against the expected
-  one and to print a diagnostic message in case of failure.
-
-  In case an exception is thrown it is caught and reported via a diagnostic
-  message to the user. The test fails in that case.
-
-  Example:
-
-  | => (defmethod is* 'in-intervall?
-  |      [t desc]
-  |      (let [[min max body] (rest t)]
-  |        `(let [min# ~min
-  |               max# ~max]
-  |           (test-driver (fn [] ~body)
-  |                        (quote ~body)
-  |                        (fn [] nil)   ; Don't need „expected result“.
-  |                        ~desc         ; Might be „nil“.
-  |                        (fn [expected# actual#]
-  |                          (<= min# actual# max#))
-  |                        (fn [expected# actual# result#]
-  |                          (diag (str „Expected:      “ actual#))
-  |                          (diag (str „to be between: “ min#))
-  |                          (diag (str „and:           “ max#))
-  |                          (diag (str „but was:       “ result#)))))))
-  |
-  | => (is (in-intervall? 100 150 (flogiston-pressure)) „flogiston pressure ok“)
-  | not ok 1 - flogiston pressure ok
-  | # Expected:      (flogiston-pressure)
-  | # to be between: 100
-  | # and:           150
-  | # but was:       58"
-  [actual qactual exp desc pred diagnose]
-  (if (= *mode* :skip)
-    (report-result *mode* true *skip-reason*)
-    (try
-      (let [e (exp)
-            a (actual)
-            r (pred e a)]
-        (report-result *mode* r desc)
-        (when-not r
-          (let [es (pr-str e)
-                as (pr-str qactual)
-                rs (pr-str a)]
-            (diagnose es as rs))
-          (when *fatal*
-            (throw (new de.kotka.tap.FatalTestError))))
-        a)
-      (catch de.kotka.tap.FatalTestError e
-        (throw e))
-      (catch Exception e
-        (report-result *mode* false desc)
-        (diag (str "Exception was thrown: " e))
-        (if *fatal*
-          (throw (new de.kotka.tap.FatalTestError))
-          `test-failed)))))

File src/de/kotka/tap/tap.clj

-;-
-; Copyright 2008 (c) Meikel Brandmeyer.
-; All rights reserved.
-;
-; Permission is hereby granted, free of charge, to any person obtaining a copy
-; of this software and associated documentation files (the "Software"), to deal
-; in the Software without restriction, including without limitation the rights
-; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-; copies of the Software, and to permit persons to whom the Software is
-; furnished to do so, subject to the following conditions:
-;
-; The above copyright notice and this permission notice shall be included in
-; all copies or substantial portions of the Software.
-;
-; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-; THE SOFTWARE.
-
-(clojure/ns de.kotka.tap
-  (:refer-clojure)
-  (:import
-     (de.kotka.tap IHarness FatalTestError))
-  (:use
-     clojure.contrib.def)
-  (:load
-     "directives.clj"
-     "harness.clj"
-     "infrastructure.clj"
-     "tests.clj"
-     "clojurecheck/arbitrary.clj"
-     "clojurecheck/combinators.clj"
-     "clojurecheck/generators.clj"))

File src/de/kotka/tap/tests.clj

-;-
-; Copyright 2008 (c) Meikel Brandmeyer.
-; All rights reserved.
-;
-; Permission is hereby granted, free of charge, to any person obtaining a copy
-; of this software and associated documentation files (the "Software"), to deal
-; in the Software without restriction, including without limitation the rights
-; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-; copies of the Software, and to permit persons to whom the Software is
-; furnished to do so, subject to the following conditions:
-;
-; The above copyright notice and this permission notice shall be included in
-; all copies or substantial portions of the Software.
-;
-; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-; THE SOFTWARE.
-
-(clojure/in-ns 'de.kotka.tap)
-
-(defn- test-tag [t] (if (seq? t) (first t) t))
-(defn- actual   [t] (second t))
-(defn- expected [t] (second (rest t)))
-
-(defmulti
-  #^{:doc
-  "is* is the driver for the is macro and should not be called directly."}
-  is*
-  (fn [x & _] (test-tag x)))
-
-(defmethod is* :default
-  [t desc]
-  `(test-driver (fn [] ~t)
-                (quote ~t)
-                (fn [] nil)
-                ~desc
-                (fn [e# a#] a#)
-                (fn [e# a# r#]
-                  (diag (.. "Expected: "
-                            (concat a#)
-                            (concat " to be true"))))))
-
-(defmethod is* '=
-  [t desc]
-  `(test-driver (fn [] ~(actual t))
-                (quote ~(actual t))
-                (fn [] ~(expected t))
-                ~desc
-                (fn [e# a#] (= e# a#))
-                (fn [e# a# r#]
-                  (diag (.concat "Expected: " a#))
-                  (diag (.concat "to be:    " e#))
-                  (diag (.concat "but was:  " r#)))))
-
-(defmethod is* 'not=
-  [t desc]
-  `(test-driver (fn [] ~(actual t))
-                (quote ~(actual t))
-                (fn [] ~(expected t))
-                ~desc
-                (fn [e# a#] (not= e# a#))
-                (fn [e# a# r#]
-                  (diag (.concat "Expected:  " a#))
-                  (diag (.concat "not to be: " e#)))))
-
-(defmethod is* 'like?
-  [t desc]
-  `(test-driver (fn [] ~(actual t))
-                (quote ~(actual t))
-                (fn [] ~(expected t))
-                ~desc
-                (fn [e# a#] (not (nil? (re-find e# a#))))
-                (fn [e# a# r#]
-                  (diag (.concat "Expected: " a#))
-                  (diag (.concat "to match: " e#)))))
-
-(defmethod is* 'unlike?
-  [t desc]
-  `(test-driver (fn [] ~(actual t))
-                (quote ~(actual t))
-                (fn [] ~(expected t))
-                ~desc
-                (fn [e# a#] (nil? (re-find e# a#)))
-                (fn [e# a# r#]
-                  (diag (.concat "Expected:     " a#))
-                  (diag (.concat "not to match: " e#))
-                  (diag (.concat "string was:   " r#)))))
-
-(defmethod is* 'throwing?
-  [t desc]
-  `(test-driver (fn []
-                  (try
-                    (do
-                      ~(second (rest t))
-                      false)
-                    (catch ~(second t) e#
-                      true)))
-                (quote ~(second (rest t)))
-                (fn [] ~(second t))
-                ~desc
-                (fn [e# a#] a#)
-                (fn [e# a# r#]
-                  (diag (.concat "Expected: " a#))
-                  (diag (.concat "to throw: " e#)))))
-
-(defmethod is* 'running?
-  [t desc]
-  `(test-driver (fn [] ~(second t))
-                (quote ~(second t))
-                (fn [] nil)
-                ~desc
-                (fn [e# a#] true)
-                (fn [e# a# r#]
-                  (diag (.concat "Expected " a#
-                                 " to run through w/o exception.")))))
-
-(defmacro is
-  "is* runs the given comparison and reports any error or Exception. Based on
-  the predicate used further diagnostic information is provided. See below
-  for a list of supported predicates and corresponding examples.
-
-  Supported Predicates:
-
-    :default  - a simply yes/no test executing the provided form, which
-                should evaluate to false in case the test fails
-    =         - compare the actual vs. the expected value using =.
-    not=      - same but with not=
-    like?     - use re-find to check whether the given string matches
-                the given regular expression
-    unlike?   - use re-find to check whether the given string does
-                not match the given regular expression
-    throwing? - check whether the form throws the given Exception
-    running?  - check whether the form runs w/o throwing an Exception
-
-  Examples:
-
-  | => (is (pressure-save? (flogiston-pressure)) „flogiston pressure is save“)
-  | not ok 1 - flogiston pressure is save
-  | # Expected: (pressure-save? (flogiston-pressure)) to be true
-
-  | => (is (= (flogiston-pressure) *normal-flogiston-pressure*)
-  |      „flogiston pressure is normal“)
-  | not ok 2 - „flogiston pressure is normal“