From 8966ebd2035e169da488c7a4abe8d6ae23e35a74 Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Sat, 14 Sep 2013 04:29:27 -0400 Subject: [PATCH] show timing for suites in rackunit gui original commit: 01fd205c9ab269a5d1cde81634eca93d0098bb43 --- .../rackunit/private/gui/interfaces.rkt | 2 +- .../rackunit/private/gui/model.rkt | 49 +++++++++++-------- .../rackunit/private/gui/model2rml.rkt | 7 +-- 3 files changed, 33 insertions(+), 25 deletions(-) diff --git a/pkgs/rackunit-pkgs/rackunit-gui/rackunit/private/gui/interfaces.rkt b/pkgs/rackunit-pkgs/rackunit-gui/rackunit/private/gui/interfaces.rkt index 6805fd8..6120703 100644 --- a/pkgs/rackunit-pkgs/rackunit-gui/rackunit/private/gui/interfaces.rkt +++ b/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 diff --git a/pkgs/rackunit-pkgs/rackunit-gui/rackunit/private/gui/model.rkt b/pkgs/rackunit-pkgs/rackunit-gui/rackunit/private/gui/model.rkt index 97cea8e..761a203 100644 --- a/pkgs/rackunit-pkgs/rackunit-gui/rackunit/private/gui/model.rkt +++ b/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]) - ([c (in-gvector children)]) - (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?)))))) + (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?)) + (+ 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)) - c) + (aggr-cases (cache-ref children-cache))) (define/public (get-total-successes) - (define-values (_c s _f _o _t) (cache-ref children-cache)) - s) + (aggr-successes (cache-ref children-cache))) (define/public (get-total-failures) - (define-values (_c _s f _o _t) (cache-ref children-cache)) - f) + (aggr-failures (cache-ref children-cache))) (define/public (has-output?) - (define-values (_c _s _f o _t) (cache-ref children-cache)) - o) + (aggr-has-output? (cache-ref children-cache))) (define/public (has-trash?) - (define-values (_c _s _f _o t) (cache-ref children-cache)) - t) + (aggr-has-trash? (cache-ref children-cache))) + (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 - (call-with-values (lambda () (cache-ref children-cache)) list)]) + (let ([result (cache-ref children-cache)]) (cache-invalidate! children-cache) - (let ([new-result - (call-with-values (lambda () (cache-ref children-cache)) list)]) + (let ([new-result (cache-ref children-cache)]) (unless (equal? new-result result) (send/i (get-controller) controller<%> on-model-status-change this))))))) diff --git a/pkgs/rackunit-pkgs/rackunit-gui/rackunit/private/gui/model2rml.rkt b/pkgs/rackunit-pkgs/rackunit-gui/rackunit/private/gui/model2rml.rkt index eee29a5..c6c9a87 100644 --- a/pkgs/rackunit-pkgs/rackunit-gui/rackunit/private/gui/model2rml.rkt +++ b/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)]