show timing for suites in rackunit gui

original commit: 01fd205c9ab269a5d1cde81634eca93d0098bb43

pkgs/rackunit-pkgs/rackunit-gui/rackunit/private/gui/interfaces.rkt

@@ -33,6 +33,7 @@
    error?
    has-output?
    has-trash?
+   get-timing
 
    get-total-cases
    get-total-successes
@@ -41,7 +42,6 @@
 (define-interface case<%> (result<%>)
   (update
    get-result
-   get-timing
    get-output
    get-trash
    get-property

pkgs/rackunit-pkgs/rackunit-gui/rackunit/private/gui/model.rkt

@@ -80,6 +80,9 @@
     (define/public (get-output) (reverse output))
     (define/public (has-output?) (pair? output))))
 
+;; An aggr contains aggregate information about a suite's children.
+(struct aggr (cases successes failures has-output? has-trash? tcpu treal tgc)
+        #:transparent)
 
 ;; suite-result%
 (define suite-result%
@@ -104,31 +107,37 @@
       (send/i (get-controller) controller<%> on-model-status-change this))
 
     (define children-cache
-      (cache (for/fold ([cs 0] [ss 0] [fs 0] [out? #f] [trash? #f])
+      (cache (call-with-values
+                 (lambda ()
+                   (for/fold ([cs 0] [ss 0] [fs 0] [out? #f] [trash? #f]
+                              [tcpu 0] [treal 0] [tgc 0])
                        ([c (in-gvector children)])
+                     (let ([timing (or (send/i c result<%> get-timing) '(0 0 0))])
                        (values (+ cs (send/i c result<%> get-total-cases))
                                (+ ss (send/i c result<%> get-total-successes))
                                (+ fs (send/i c result<%> get-total-failures))
                                (or out? (send/i c result<%> has-output?))
-                       (or trash? (send/i c result<%> has-trash?))))))
+                               (or trash? (send/i c result<%> has-trash?))
+                               (+ tcpu (car timing))
+                               (+ treal (cadr timing))
+                               (+ tgc (caddr timing))))))
+               aggr)))
 
     (define/public (finished?)
       done?)
     (define/public (get-total-cases)
-      (define-values (c _s _f _o _t) (cache-ref children-cache))
+      (aggr-cases (cache-ref children-cache)))
-      c)
     (define/public (get-total-successes)
-      (define-values (_c s _f _o _t) (cache-ref children-cache))
+      (aggr-successes (cache-ref children-cache)))
-      s)
     (define/public (get-total-failures)
-      (define-values (_c _s f _o _t) (cache-ref children-cache))
+      (aggr-failures (cache-ref children-cache)))
-      f)
     (define/public (has-output?)
-      (define-values (_c _s _f o _t) (cache-ref children-cache))
+      (aggr-has-output? (cache-ref children-cache)))
-      o)
     (define/public (has-trash?)
-      (define-values (_c _s _f _o t) (cache-ref children-cache))
+      (aggr-has-trash? (cache-ref children-cache)))
-      t)
+    (define/public (get-timing)
+      (let ([a (cache-ref children-cache)])
+        (list (aggr-tcpu a) (aggr-treal a) (aggr-tgc a))))
 
     (define/public (success?)
       (and (finished?) (zero? (get-total-failures))))
@@ -138,10 +147,8 @@
 
     ;; on-child-status-change : model<%> -> void
     (define/public (on-child-status-change child)
-      (let ([result
+      (let ([result (cache-ref children-cache)])
-             (call-with-values (lambda () (cache-ref children-cache)) list)])
         (cache-invalidate! children-cache)
-        (let ([new-result
+        (let ([new-result (cache-ref children-cache)])
-               (call-with-values (lambda () (cache-ref children-cache)) list)])
           (unless (equal? new-result result)
             (send/i (get-controller) controller<%> on-model-status-change this)))))))

pkgs/rackunit-pkgs/rackunit-gui/rackunit/private/gui/model2rml.rkt

@@ -122,7 +122,8 @@
                                     count-successes
                                     num-tests))
                        (for-each (lambda (m) (render-model/short m)) successes)
-                       (blank)))
+                       (blank))
+                     (render-timing model))
               (if finished?
                   (put '()
                        "This test suite is empty.")
@@ -158,7 +159,7 @@
                   (put `(,style)
                        (format " (~a)"
                                (n-things total-failures "failure" "failures"))))
-                (put '(test-unexecuted) " not yet executed"))
+                (put '(test-unexecuted) " not yet finished"))
             (blank)))))
 
     (define/private (render-case-short-form model)
@@ -428,7 +429,7 @@
           (blank))))
 
     (define/private (render-timing model)
-      (let [(timing (send/i model case<%> get-timing))]
+      (let [(timing (send/i model result<%> get-timing))]
         (when timing
           (let ([cpu (car timing)]
                 [real (cadr timing)]