save results in .tg for later analysis

Author: stuarthalloway

.gitignore

@@ -1 +1,2 @@
 target
+.tg/*

bin/repl

@@ -2,6 +2,6 @@
 # Note: First you must run mvn dependency:build-classpath -Dmdep.outputFile=bin/maven-classpath 
 CLASSPATH=src/main/clojure:src/test/clojure:src/examples/clojure:`cat bin/maven-classpath`
 
-java -server -Xmx2GB -cp $CLASSPATH clojure.main "$@"
+java -server -Xmx2GB $CTG_JAVA_OPTS -cp $CLASSPATH clojure.main "$@"
 
 

data-model.org

@@ -42,7 +42,6 @@
 | :test/group  | x               | x     |      |              |      |         | info  |
 | :test/iter   |                 |       | x    |              |      |         | info  |
 | :test/test   | x               | x     |      |              | x    |         | info  |
-| :test/seed   |                 |       |      |              |      |         | info  |
 | :test/fail   |                 |       |      |              |      | x       | warn  |
 | :test/pass   |                 |       |      |              |      |         | info  |
 | :assert/pass |                 |       |      |              |      |         | debug |

src/main/clojure/clojure/test/generative/event.clj

@@ -31,6 +31,15 @@
                 (symbol (str ns "/" (.sym v)))
                 (.sym v))))
 
+(defn level-enabled?
+  "Is the event-level enabled?"
+  [event-level enable-level]
+  (case enable-level
+        :error (case event-level (:error) true false)
+        :warn (case event-level (:error :warn) true false)
+        :info (case event-level (:error :warn :info) true false)
+        :debug true))
+
 (def ^long pid
   "Process id"
   (read-string (.getName (java.lang.management.ManagementFactory/getRuntimeMXBean))))

src/main/clojure/clojure/test/generative/io.clj

@@ -22,12 +22,17 @@
 (defn serialized
   "Returns a function that calls f for side effects, async,
    serialized by an agent"
-  [f]
-  (fn [& args]
-    (send-off serializer
-              (fn [_]
-                (apply f args)
-                nil))))
+  ([f] (serialized f serializer))
+  ([f agt]
+     (fn [& args]
+       (send-off agt
+                 (fn [_]
+                   (try
+                    (apply f args)
+                    (catch Throwable t
+                      (.printStackTrace t)))
+                   nil))
+       nil)))
 
 ;; TODO set from Java property?
 (def ^:private event-print-length 100)
@@ -41,31 +46,18 @@
     (clojure.core/pr-str s)))
 
 (def println
-  "Print with event print settings"
+  "threadsafe print with event print settings"
   (serialized clojure.core/println))
 
 (def pprint
-  "Print with event print settings"
+  "threadsafe pprint with event print settings"
   (serialized
    (fn [s]
      (binding [*print-length* event-print-length
                *print-level* event-print-level]
        (pprint/pprint s)
        (flush)))))
 
-(def last-dot (atom 0))
-
-#_(defn dot-progress
-  "Prints a dot per event, throttled to ten dots/sec."
-  [{:keys [tstamp]}]
-  (when (< 100 (- tstamp @last-dot))
-    (reset! last-dot tstamp)
-    (send-off serializer
-              (fn [_] 
-                (print ".")
-                (flush)
-                nil))))
-
 (def report-hierarchy
   (reduce
    #(apply derive %1 %2)
@@ -78,7 +70,6 @@
 
 (defmulti console-reporter :type :hierarchy #'report-hierarchy)
 
-#_(defmethod console-reporter :progress [m] (dot-progress m))
 (defmethod console-reporter :ignore [_])
 (defmethod console-reporter :test/test
   [{:keys [tags msec count] :as m}]

src/main/clojure/clojure/test/generative/runner.clj

@@ -9,6 +9,8 @@
 
 (ns clojure.test.generative.runner
   (:require
+   [clojure.java.io :as jio]
+   [clojure.pprint :as pprint]
    [clojure.tools.namespace :as ns]
    [clojure.test.generative.config :as config]
    [clojure.test.generative.event :as event]
@@ -48,11 +50,11 @@
   (let [name (test-name test)
         f (test-fn test)
         input (test-input test)]
-    (event/report :test/iter :name name :args input :tags #{:begin})
+    (event/report :test/iter :level :debug :name name :args input :tags #{:begin})
     (try
      (let [result (apply f input)]
        (when-not (realized? *failed*)
-         (event/report :test/iter :name name :return result :tags #{:end})))
+         (event/report :test/iter :level :debug :name name :return result :tags #{:end})))
      (catch Throwable t
        (deliver *failed* :error)
        (event/report :error :name name :exception t)))))
@@ -66,11 +68,10 @@
               (map
                #(future
                  (try
-                  (event/report :test/seed :test/seed (+ % 42))
                   (binding [gen/*seed* (+ % 42)
                             gen/*rnd* (java.util.Random. gen/*seed*)
                             *failed* (promise)]
-                    (event/report :test/test :tags #{:begin})
+                    (event/report :test/test :tags #{:begin} :test/seed (+ % 42) :name (test-name test))
                     (loop [iter 0]
                       (let [result (run-iter test)
                             now (System/currentTimeMillis)
@@ -184,26 +185,60 @@
       (:test/fail result)
       (:error result)))
 
+(def process-id
+  (delay
+   (java.util.UUID/randomUUID)))
+
+(def storage-writer
+  (delay
+   (let [f (str ".tg/" @process-id)]
+     (jio/make-parents f)
+     (jio/writer f :append true))))
+
+(def store-agent (agent nil))
+
+(def store
+  "store data in .tg/{process-id}"
+  (io/serialized
+   (fn [e]
+     (binding [*print-length* nil
+               *print-level* nil
+               *out* @storage-writer]
+       (println e)))
+   store-agent))
+
+(defn save
+  "Save results at info level or higher, using store."
+  [e]
+  (when (event/level-enabled? (:level e) :info)
+    (store e)))
+
+(defn test-dirs
+  "Runs tests in dirs, returning a map of test lib keyword
+   to summary data"
+  [& dirs]
+  (let [nses (mapcat #(ns/find-namespaces-in-dir (java.io.File. ^String %)) dirs)
+        conf (config/config)]
+    (doseq [ns nses] (require ns))
+    (event/install-default-handlers)
+    (run-all-tests nses (:threads conf) (:msec conf))))
+
 (defn -main
   "Command line entry point, runs all tests in dirs using clojure.test and
    test.generative. Calls System.exit!"
   [& dirs]
   (if (seq dirs)
-    (let [nses (mapcat #(ns/find-namespaces-in-dir (java.io.File. ^String %)) dirs)
-          conf (config/config)]
-      (doseq [ns nses] (require ns))
-      (event/install-default-handlers)
-      (try
-       (let [results (run-all-tests nses (:threads conf) (:msec conf))]
-         (doseq [[k v] results]
-           (println (str "\nFramework " k))
-           (println v))
-         (System/exit (if (some failed? (vals results)) 1 0)))
-       (catch Throwable t
-         (.printStackTrace t)
-         (System/exit -1))
-       (finally
-        (shutdown-agents))))
+    (try
+     (let [results (apply test-dirs dirs)]
+       (doseq [[k v] results]
+         (println (str "\nFramework " k))
+         (println v))
+       (System/exit (if (some failed? (vals results)) 1 0)))
+     (catch Throwable t
+       (.printStackTrace t)
+       (System/exit -1))
+     (finally
+      (shutdown-agents)))
     (do
       (println "Specify at least one directory with tests")
       (System/exit -1))))