Revert "Fix bound-identifier=? to compare binding names, not just symbolic names."

[bpt/guile.git] / test-suite / tests / statprof.test

diff --git a/test-suite/tests/statprof.test b/test-suite/tests/statprof.test
index 22fce32..1fec617 100644 (file)
--- a/test-suite/tests/statprof.test
+++ b/test-suite/tests/statprof.test
@@ -1,5 +1,5 @@
 ;; guile-lib                    -*- scheme -*-
-;; Copyright (C) 2004, 2009 Andy Wingo <wingo at pobox dot com>
+;; Copyright (C) 2004, 2009, 2010 Andy Wingo <wingo at pobox dot com>
 ;; Copyright (C) 2001 Rob Browning <rlb at defaultvalue dot org>
 
 ;; This library is free software; you can redistribute it and/or
@@ -31,12 +31,22 @@
   #:use-module (srfi srfi-1)
   #:use-module (statprof))
 
-;; FIXME
-(debug-enable 'debug)
-(trap-enable 'traps)
+;; Throw `unresolved' upon ENOSYS.  This is used to skip tests on
+;; platforms such as GNU/Hurd where `ITIMER_PROF' is is currently
+;; unimplemented.
+(define-syntax-rule (when-implemented body ...)
+  (catch 'system-error
+    (lambda ()
+      body ...)
+    (lambda args
+      (let ((errno (system-error-errno args)))
+        (false-if-exception (statprof-stop))
+        (if (= errno ENOSYS)
+            (throw 'unresolved)
+            (apply throw args))))))
 
 (pass-if "statistical sample counts within expected range"
-  (let ()
+  (when-implemented
     ;; test to see that if we call 3 identical functions equally, they
     ;; show up equally in the call count, +/- 30%. it's a big range, and
     ;; I tried to do something more statistically valid, but failed (for
@@ -44,53 +54,61 @@
 
     ;; make sure these are compiled so we're not swamped in `eval'
     (define (make-func)
+      ;; Disable partial evaluation so that `(+ i i)' doesn't get
+      ;; stripped.
       (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)))
     (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 ((num-calls 40000)
-          (funcs (circular-list (make-func) (make-func) (make-func))))
+                 (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))))
 
-      ;; Run test. 10000 us == 100 Hz.
-      (statprof-reset 0 10000 #f #f)
+      ;; Run test. 20000 us == 200 Hz.
+      (statprof-reset 0 20000 #f #f)
       (statprof-start)
       (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 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"
-  (let ()
+  (when-implemented
     ;; Test to see that if we call a function N times while the profiler
     ;; is active, it shows up N times.
     (let ((num-calls 200))
 
-      (define (do-nothing n)
-        (simple-format #f "FOO ~A\n" (+ n n)))
+      (define do-nothing
+        (compile '(lambda (n)
+                    (simple-format #f "FOO ~A\n" (+ n n)))))
     
-      (throw 'unresolved) ;; need to fix VM tracing.
-
       ;; Run test.
       (statprof-reset 0 50000 #t #f)
       (statprof-start)
@@ -102,8 +120,6 @@
           #t)))
       (statprof-stop)
     
-      ;;(statprof-display)
-
       ;; Check result.
       (let ((proc-data (statprof-proc-call-data do-nothing)))
         (and proc-data