Permalink
Browse files

save results in .tg for later analysis

  • Loading branch information...
1 parent f2ba32f commit d1aeae81971171e7548f0cf68863f64d9cfab967 @stuarthalloway stuarthalloway committed Aug 24, 2012
View
@@ -1 +1,2 @@
target
+.tg/*
View
@@ -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 "$@"
View
@@ -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 |
@@ -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))))
@@ -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}]
@@ -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))))

0 comments on commit d1aeae8

Please sign in to comment.