test-suite/tests/statprof.test

   1 ;; guile-lib                    -*- scheme -*-
   2 ;; Copyright (C) 2004, 2009, 2010 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 (pass-if "statistical sample counts within expected range"
  35   (let ()
  36     ;; test to see that if we call 3 identical functions equally, they
  37     ;; show up equally in the call count, +/- 30%. it's a big range, and
  38     ;; I tried to do something more statistically valid, but failed (for
  39     ;; the moment).
  40
  41     ;; make sure these are compiled so we're not swamped in `eval'
  42     (define (make-func)
  43       ;; Disable partial evaluation so that `(+ i i)' doesn't get
  44       ;; stripped.
  45       (compile '(lambda (n)
  46                   (do ((i 0 (+ i 1))) ((= 200 i)) (+ i i)))
  47                #:opts '(#:partial-eval? #f)))
  48     (define run-test
  49       (compile '(lambda (num-calls funcs)
  50                   (let loop ((x num-calls) (funcs funcs))
  51                     (cond
  52                      ((positive? x)
  53                       ((car funcs) x)
  54                       (loop (- x 1) (cdr funcs))))))))
  55
  56     (let ((num-calls 80000)
  57           (funcs (circular-list (make-func) (make-func) (make-func))))
  58
  59       ;; Run test. 20000 us == 200 Hz.
  60       (statprof-reset 0 20000 #f #f)
  61       (statprof-start)
  62       (run-test num-calls funcs)
  63       (statprof-stop)
  64
  65       (let* ((a-data (statprof-proc-call-data (car funcs)))
  66              (b-data (statprof-proc-call-data (cadr funcs)))
  67              (c-data (statprof-proc-call-data (caddr funcs)))
  68              (samples (map statprof-call-data-cum-samples
  69                            (list a-data b-data c-data)))
  70              (average (/ (apply + samples) 3))
  71              (max-allowed-drift 0.30) ; 30%
  72              (diffs (map (lambda (x) (abs (- x average)))
  73                          samples))
  74              (max-diff (apply max diffs)))
  75
  76         (let ((drift-fraction (/ max-diff average)))
  77           (or (< drift-fraction max-allowed-drift)
  78               ;; don't stop the test suite for what statistically is
  79               ;; bound to happen.
  80               (throw 'unresolved (pk average drift-fraction))))))))
  81
  82 (pass-if "accurate call counting"
  83   (let ()
  84     ;; Test to see that if we call a function N times while the profiler
  85     ;; is active, it shows up N times.
  86     (let ((num-calls 200))
  87
  88       (define do-nothing
  89         (compile '(lambda (n)
  90                     (simple-format #f "FOO ~A\n" (+ n n)))))
  91
  92       ;; Run test.
  93       (statprof-reset 0 50000 #t #f)
  94       (statprof-start)
  95       (let loop ((x num-calls))
  96         (cond
  97          ((positive? x)
  98           (do-nothing x)
  99           (loop (- x 1))
 100           #t)))
 101       (statprof-stop)
 102
 103       ;; Check result.
 104       (let ((proc-data (statprof-proc-call-data do-nothing)))
 105         (and proc-data
 106              (= (statprof-call-data-calls proc-data)
 107                 num-calls))))))