mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00
Code Activity

Have `statprof.test' fail gracefully when samples could not be collected.

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2012-01-14 23:02:03 +01:00
parent 25dc93dd57
commit 6f0e534fcf
1 changed files with 30 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

14
test-suite/tests/statprof.test
View file

@ -76,10 +76,11 @@
(run-test num-calls funcs) (run-test num-calls funcs)
(statprof-stop) (statprof-stop)
(let* ((a-data (statprof-proc-call-data (car funcs))) (let ((a-data (statprof-proc-call-data (car funcs)))
(b-data (statprof-proc-call-data (cadr funcs))) (b-data (statprof-proc-call-data (cadr funcs)))
(c-data (statprof-proc-call-data (caddr funcs))) (c-data (statprof-proc-call-data (caddr funcs))))
(samples (map statprof-call-data-cum-samples (if (and a-data b-data c-data)
(let* ((samples (map statprof-call-data-cum-samples
(list a-data b-data c-data))) (list a-data b-data c-data)))
(average (/ (apply + samples) 3)) (average (/ (apply + samples) 3))
(max-allowed-drift 0.30) ; 30% (max-allowed-drift 0.30) ; 30%
@ -91,7 +92,12 @@
(or (< drift-fraction max-allowed-drift) (or (< drift-fraction max-allowed-drift)
;; don't stop the test suite for what statistically is ;; don't stop the test suite for what statistically is
;; bound to happen. ;; bound to happen.
(throw 'unresolved (pk average drift-fraction)))))))) (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" (pass-if "accurate call counting"
(when-implemented (when-implemented