Commits

Meikel Brandmeyer committed 49f7801

Make the harness a interface (IHarness) instead of a map

  • Participants
  • Parent commits cea4589

Comments (0)

Files changed (4)

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])

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)))))
+
+(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.")

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

 
 (clojure/in-ns 'de.kotka.tap)
 
-(defstruct harness :plan :diag :bail-out :report-result)
-
-(defvar *the-harness*
-  (let [current-test (ref 1)]
-    (struct harness
-            ; plan
-            (fn [count]
-              (print "1..")
-              (print count)
-              (newline)
-              (flush))
-
-            ; diag
-            (fn [msg]
-              (doseq l (.split msg "\n")
-                (print "# ")
-                (print l)
-                (newline)
-                (flush)))
-
-            ; bail-out
-            (fn [& msg]
-              (print "Bail out!")
-              (when-not (nil? msg)
-                (print " ")
-                (print (first msg)))
-              (newline)
-              (flush)
-              (.exit java.lang.System 1))
-
-            ; report-result
-            (fn [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))))
-  "The handlers. This actually implements the TAP protocol itself, but may be
-  re-bound via binding to enable different behaviour.")
-
-
 (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
   | => (plan 10)
   | 1..10"
   [count]
-  ((*the-harness* :plan) count))
+  (. *the-harness* plan count))
 
 (defn diag
   "Print diagnostics. Sometimes a test script wants to provide diagnostic
   | => (diag „flogiston pressure dropping rapidly“)
   | # flogiston pressure dropping rapidly"
   [msg]
-  ((*the-harness* :diag) msg))
+  (. *the-harness* diag msg))
 
 (defn bail-out
   "Bail out of the test process. Sometimes the system or the environment is so
   | Bail out!
   | => (bail-out „flogiston pressure too low“)
   | Bail out! flogiston pressure too low"
-  [& msg]
-  (apply (*the-harness* :bail-out) msg))
+  ([]    (. *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
   | # but was:       58"
   [actual qactual exp desc pred diagnose]
   (if (= *mode* :skip)
-    ((*the-harness* :report-result) *mode* true *skip-reason*)
+    (report-result *mode* true *skip-reason*)
     (try
       (let [e (exp)
             a (actual)
             r (pred e a)]
-        ((*the-harness* :report-result) *mode* r desc)
+        (report-result *mode* r desc)
         (when-not r
           (let [es (pr-str e)
                 as (pr-str qactual)
             (diagnose es as rs)))
         a)
       (catch Exception e
-        ((*the-harness* :report-result) *mode* false desc)
+        (report-result *mode* false desc)
         (diag (str "Exception was thrown: " e))
         `test-failed))))

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

 
 (clojure/ns de.kotka.tap
   (:refer-clojure)
-  (:use clojure.contrib.def)
-  (:load "directives.clj"
-         "infrastructure.clj"
-         "tests.clj"))
+  (:import
+     (de.kotka.tap IHarness))
+  (:use
+     clojure.contrib.def)
+  (:load
+     "directives.clj"
+     "harness.clj"
+     "infrastructure.clj"
+     "tests.clj"))