[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.3-155-g6f0e534

[Ludovic Courtès]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=6f0e534fcfe8b465ae383a62b97f5ff71086d474

The branch, stable-2.0 has been updated
       via  6f0e534fcfe8b465ae383a62b97f5ff71086d474 (commit)
      from  25dc93dd575994fabdcfb558521d3287f604f081 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 6f0e534fcfe8b465ae383a62b97f5ff71086d474
Author: Ludovic Courtès <address@hidden>
Date:   Sat Jan 14 23:02:03 2012 +0100

    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.

-----------------------------------------------------------------------

Summary of changes:
 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 c711d5f..1fec617 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


hooks/post-receive
-- 
GNU Guile