test-suite/tests/statprof.test

   1 ;; guile-lib                    -*- scheme -*-
   2 ;; Copyright (C) 2004, 2009, 2010, 2014 Andy Wingo <wingo at pobox dot com>
   3 ;; Copyright (C) 2001 Rob Browning <rlb at defaultvalue dot org>
   4
   5 ;; This library is free software; you can redistribute it and/or
   6 ;; modify it under the terms of the GNU Lesser General Public
   7 ;; License as published by the Free Software Foundation; either
   8 ;; version 2.1 of the License, or (at your option) any later version.
   9 ;;
  10 ;; This library is distributed in the hope that it will be useful,
  11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ;; Lesser General Public License for more details.
  14 ;;
  15 ;; You should have received a copy of the GNU Lesser General Public
  16 ;; License along with this program; if not, contact:
  17 ;;
  18 ;; Free Software Foundation           Voice:  +1-617-542-5942
  19 ;; 59 Temple Place - Suite 330        Fax:    +1-617-542-2652
  20 ;; Boston, MA  02111-1307,  USA       gnu@gnu.org
  21
  22 ;;; Commentary:
  23 ;;
  24 ;; Unit tests for (debugging statprof).
  25 ;;
  26 ;;; Code:
  27
  28 (define-module (test-suite test-statprof)
  29   #:use-module (test-suite lib)
  30   #:use-module (system base compile)
  31   #:use-module (srfi srfi-1)
  32   #:use-module (statprof))
  33
  34 ;; Throw `unresolved' upon ENOSYS.  This is used to skip tests on
  35 ;; platforms such as GNU/Hurd where `ITIMER_PROF' is is currently
  36 ;; unimplemented.
  37 (define-syntax-rule (when-implemented body ...)
  38   (catch 'system-error
  39     (lambda ()
  40       body ...)
  41     (lambda args
  42       (let ((errno (system-error-errno args)))
  43         (false-if-exception (statprof-stop))
  44         (if (= errno ENOSYS)
  45             (throw 'unresolved)
  46             (apply throw args))))))
  47
  48 (pass-if "statistical sample counts within expected range"
  49   (when-implemented
  50     ;; test to see that if we call 3 identical functions equally, they
  51     ;; show up equally in the call count, +/- 30%. it's a big range, and
  52     ;; I tried to do something more statistically valid, but failed (for
  53     ;; the moment).
  54
  55     ;; make sure these are compiled so we're not swamped in `eval'
  56     (define (make-func)
  57       ;; Disable partial evaluation so that `(+ i i)' doesn't get
  58       ;; stripped.
  59       (compile '(lambda (n)
  60                   (do ((i 0 (+ i 1))) ((= 200 i)) (+ i i)))
  61                #:opts '(#:partial-eval? #f)))
  62     (define run-test
  63       (compile '(lambda (num-calls funcs)
  64                   (let loop ((x num-calls) (funcs funcs))
  65                     (cond
  66                      ((positive? x)
  67                       ((car funcs) x)
  68                       (loop (- x 1) (cdr funcs))))))))
  69
  70     (let ((num-calls 200000)
  71           (funcs (circular-list (make-func) (make-func) (make-func))))
  72
  73       ;; Run test. 20000 us == 200 Hz.
  74       (statprof-reset 0 20000 #f #f)
  75       (statprof-start)
  76       (run-test num-calls funcs)
  77       (statprof-stop)
  78
  79       (let ((a-data (statprof-proc-call-data (car funcs)))
  80             (b-data (statprof-proc-call-data (cadr funcs)))
  81             (c-data (statprof-proc-call-data (caddr funcs))))
  82         (if (and a-data b-data c-data)
  83             (let* ((samples (map statprof-call-data-cum-samples
  84                                  (list a-data b-data c-data)))
  85                    (expected (/ (apply + samples) 3.0))
  86                    (diffs (map (lambda (x) (abs (- x expected)))
  87                                samples))
  88                    (max-diff (apply max diffs)))
  89
  90               (or (< max-diff (sqrt expected))
  91                   ;; don't stop the test suite for what statistically is
  92                   ;; bound to happen.
  93                   (begin
  94                     (format (current-warning-port)
  95                             ";;; warning: max diff ~a > (sqrt ~a)\n"
  96                             max-diff expected)
  97                     (throw 'unresolved))))
  98
  99             ;; Samples were not collected for at least one of the
 100             ;; functions, possibly because NUM-CALLS is too low compared
 101             ;; to the CPU speed.
 102             (throw 'unresolved (pk (list a-data b-data c-data))))))))
 103
 104 (pass-if "accurate call counting"
 105   (when-implemented
 106     ;; Test to see that if we call a function N times while the profiler
 107     ;; is active, it shows up N times.
 108     (let ((num-calls 200))
 109
 110       (define do-nothing
 111         (compile '(lambda (n)
 112                     (simple-format #f "FOO ~A\n" (+ n n)))))
 113
 114       ;; Run test.
 115       (statprof-reset 0 50000 #t #f)
 116       (statprof-start)
 117       (let loop ((x num-calls))
 118         (cond
 119          ((positive? x)
 120           (do-nothing x)
 121           (loop (- x 1))
 122           #t)))
 123       (statprof-stop)
 124
 125       ;; Check result.
 126       (let ((proc-data (statprof-proc-call-data do-nothing)))
 127         (and proc-data
 128              (= (statprof-call-data-calls proc-data)
 129                 num-calls))))))