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

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

@ -57,18 +57,18 @@
;; Disable partial evaluation so that `(+ i i)' doesn't get ;; Disable partial evaluation so that `(+ i i)' doesn't get
;; stripped. ;; stripped.
(compile '(lambda (n) (compile '(lambda (n)
(do ((i 0 (+ i 1))) ((= 200 i)) (+ i i))) (do ((i 0 (+ i 1))) ((= 200 i)) (+ i i)))
#:opts '(#:partial-eval? #f))) #:opts '(#:partial-eval? #f)))
(define run-test (define run-test
(compile '(lambda (num-calls funcs) (compile '(lambda (num-calls funcs)
(let loop ((x num-calls) (funcs funcs)) (let loop ((x num-calls) (funcs funcs))
(cond (cond
((positive? x) ((positive? x)
((car funcs) x) ((car funcs) x)
(loop (- x 1) (cdr funcs)))))))) (loop (- x 1) (cdr funcs))))))))
(let ((num-calls 80000) (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. ;; Run test. 20000 us == 200 Hz.
(statprof-reset 0 20000 #f #f) (statprof-reset 0 20000 #f #f)
@ -76,22 +76,28 @@
(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)
(list a-data b-data c-data))) (let* ((samples (map statprof-call-data-cum-samples
(average (/ (apply + samples) 3)) (list a-data b-data c-data)))
(max-allowed-drift 0.30) ; 30% (average (/ (apply + samples) 3))
(diffs (map (lambda (x) (abs (- x average))) (max-allowed-drift 0.30) ; 30%
samples)) (diffs (map (lambda (x) (abs (- x average)))
(max-diff (apply max diffs))) samples))
(max-diff (apply max diffs)))
(let ((drift-fraction (/ max-diff average))) (let ((drift-fraction (/ max-diff average)))
(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