reporting tweaks, fix timeslicing

Author: stuarthalloway

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

@@ -17,7 +17,7 @@
   []
   "Wait for everything sent to the serializer"
   (send-off serializer (fn [_]))
-  (clojure.core/await))
+  (clojure.core/await serializer))
 
 (defn serialized
   "Returns a function that calls f for side effects, async,
@@ -55,7 +55,7 @@
 
 (def last-dot (atom 0))
 
-(defn dot-progress
+#_(defn dot-progress
   "Prints a dot per event, throttled to ten dots/sec."
   [{:keys [tstamp]}]
   (when (< 100 (- tstamp @last-dot))
@@ -70,17 +70,20 @@
   (reduce
    #(apply derive %1 %2)
    (make-hierarchy)
-   [[:test/test :progress]
-    [:test/iter :progress]
-    [:test/seed :progress]
-    [:test/pass :progress]
-    [:assert/pass :progress]
+   [[:test/iter :ignore]
+    [:test/seed :ignore]
+    [:test/pass :ignore]
+    [:assert/pass :ignore]
     [:assert/summary :ignore]]))
 
 (defmulti console-reporter :type :hierarchy #'report-hierarchy)
 
-(defmethod console-reporter :progress [m] (dot-progress m))
+#_(defmethod console-reporter :progress [m] (dot-progress m))
 (defmethod console-reporter :ignore [_])
+(defmethod console-reporter :test/test
+  [{:keys [tags msec] :as m}]
+  (when (and (tags :end))
+      (println (select-keys m [:msec :test/result :name :count]))))
 (defmethod console-reporter :test/group
   [{:keys [name tags]}]
   (when-not (tags :end)

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

@@ -27,7 +27,6 @@
   ^String [event]
   (event/fqname (or (:ns event)
                     (:type event)
-                    (:name event)
                     "root")))
 
 (defn event->logback
@@ -36,7 +35,7 @@
   (let [name (logger-name event)
         logger ^ch.qos.logback.classic.Logger (LoggerFactory/getLogger name)
         msg (delay (binding [*print-length* 50]
-                     (pr-str (dissoc event :level :thread :tstamp :name))))
+                     (pr-str (dissoc event :level :thread :tstamp :thread/name))))
         level (level->logback (:level event))
         logback-event (reify ILoggingEvent
                              (getThreadName [_] (str (:thread/name event)))

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

@@ -80,7 +80,7 @@
                           (recur (inc iter))
                           (event/report :test/test
                                         :msec (- now start)
-                                        :count iter
+                                        :count (inc iter)
                                         :tags #{:end}
                                         :test/result (if failed? :test/fail :test/pass)
                                         :level (if failed? :warn :info)
@@ -91,13 +91,12 @@
     (doseq [f futs] @f)))
 
 (defn run-batch
-  "Run a batch of fs on nthreads each. Try to divide msec
-   among the fs. Args like run-for."
-  [tests nthreads msec]
+  "Run a batch of fs on nthreads each. Call each f repeatedly
+   for up to test-msec"
+  [tests nthreads test-msec]
   (when (seq tests)
-    (let [msec-per-f (quot msec (count tests))]
-      (doseq [test tests]
-        (run-for test nthreads msec-per-f)))))
+    (doseq [test tests]
+      (run-for test nthreads test-msec))))
 
 (defn failed!
   "Tell the runner that a test failed"
@@ -131,22 +130,25 @@
 (defn run-generative-tests
   "Run generative tests."
   [nses nthreads msec]
-  (doseq [ns nses]
-    (when-let [fs (->> (find-vars-in-namespaces ns)
-                       (filter gentest?)
-                       seq)]
-      (event/report :test/group
-                    :name ns
-                    :tags #{:begin}
-                    :test/threads nthreads
-                    :test/count (count fs))
-      (try
-       (run-batch
-        fs
-        nthreads
-        (quot msec (count nses)))
-       (finally
-        (event/report :test/group :tags #{:end} :test/threads nthreads :test/count (count fs)))))))
+  (let [test-msec (quot msec (count (->> (apply find-vars-in-namespaces nses)
+                                         (filter gentest?)
+                                         seq)))]
+    (doseq [ns nses]
+      (when-let [fs (->> (find-vars-in-namespaces ns)
+                         (filter gentest?)
+                         seq)]
+        (event/report :test/group
+                      :name ns
+                      :tags #{:begin}
+                      :test/threads nthreads
+                      :test/count (count fs))
+        (try
+         (run-batch
+          fs
+          nthreads
+          test-msec)
+         (finally
+          (event/report :test/group :tags #{:end} :test/threads nthreads :test/count (count fs))))))))
 
 (defn run-all-tests
   "Run generative tests and clojure.test tests"