diff options
author | Ludovic Courtès <ludo@gnu.org> | 2012-01-14 23:02:03 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2012-01-14 23:02:03 +0100 |
commit | 6f0e534fcfe8b465ae383a62b97f5ff71086d474 (patch) | |
tree | f34341f2ae6a0fdf5077bb3d62a1848946398d4e | |
parent | 25dc93dd575994fabdcfb558521d3287f604f081 (diff) | |
download | guile-6f0e534fcfe8b465ae383a62b97f5ff71086d474.tar.gz |
Have `statprof.test' fail gracefully when samples could not be collected.
* test-suite/tests/statprof.test ("statistical sample counts within
expected range"): Throw unresolved when one of A-DATA, B-DATA, and
C-DATA is #f, which means samples were not collected for this one.
-rw-r--r-- | test-suite/tests/statprof.test | 54 |
1 files changed, 30 insertions, 24 deletions
diff --git a/test-suite/tests/statprof.test b/test-suite/tests/statprof.test index c711d5f36..1fec61765 100644 --- a/test-suite/tests/statprof.test +++ b/test-suite/tests/statprof.test @@ -57,18 +57,18 @@ ;; Disable partial evaluation so that `(+ i i)' doesn't get ;; stripped. (compile '(lambda (n) - (do ((i 0 (+ i 1))) ((= 200 i)) (+ i i))) - #:opts '(#:partial-eval? #f))) + (do ((i 0 (+ i 1))) ((= 200 i)) (+ i i))) + #:opts '(#:partial-eval? #f))) (define run-test (compile '(lambda (num-calls funcs) - (let loop ((x num-calls) (funcs funcs)) - (cond - ((positive? x) - ((car funcs) x) - (loop (- x 1) (cdr funcs)))))))) - + (let loop ((x num-calls) (funcs funcs)) + (cond + ((positive? x) + ((car funcs) x) + (loop (- x 1) (cdr funcs)))))))) + (let ((num-calls 80000) - (funcs (circular-list (make-func) (make-func) (make-func)))) + (funcs (circular-list (make-func) (make-func) (make-func)))) ;; Run test. 20000 us == 200 Hz. (statprof-reset 0 20000 #f #f) @@ -76,22 +76,28 @@ (run-test num-calls funcs) (statprof-stop) - (let* ((a-data (statprof-proc-call-data (car funcs))) - (b-data (statprof-proc-call-data (cadr funcs))) - (c-data (statprof-proc-call-data (caddr funcs))) - (samples (map statprof-call-data-cum-samples - (list a-data b-data c-data))) - (average (/ (apply + samples) 3)) - (max-allowed-drift 0.30) ; 30% - (diffs (map (lambda (x) (abs (- x average))) - samples)) - (max-diff (apply max diffs))) + (let ((a-data (statprof-proc-call-data (car funcs))) + (b-data (statprof-proc-call-data (cadr funcs))) + (c-data (statprof-proc-call-data (caddr funcs)))) + (if (and a-data b-data c-data) + (let* ((samples (map statprof-call-data-cum-samples + (list a-data b-data c-data))) + (average (/ (apply + samples) 3)) + (max-allowed-drift 0.30) ; 30% + (diffs (map (lambda (x) (abs (- x average))) + samples)) + (max-diff (apply max diffs))) + + (let ((drift-fraction (/ max-diff average))) + (or (< drift-fraction max-allowed-drift) + ;; don't stop the test suite for what statistically is + ;; bound to happen. + (throw 'unresolved (pk average drift-fraction))))) - (let ((drift-fraction (/ max-diff average))) - (or (< drift-fraction max-allowed-drift) - ;; don't stop the test suite for what statistically is - ;; bound to happen. - (throw 'unresolved (pk average drift-fraction)))))))) + ;; Samples were not collected for at least one of the + ;; functions, possibly because NUM-CALLS is too low compared + ;; to the CPU speed. + (throw 'unresolved (pk (list a-data b-data c-data)))))))) (pass-if "accurate call counting" (when-implemented |