1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
;; guile-lib -*- scheme -*-
;; 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
;; modify it under the terms of the GNU Lesser General Public
;; License as published by the Free Software Foundation; either
;; version 2.1 of the License, or (at your option) any later version.
;;
;; This library is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Lesser General Public License for more details.
;;
;; You should have received a copy of the GNU Lesser General Public
;; License along with this program; if not, contact:
;;
;; Free Software Foundation Voice: +1-617-542-5942
;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652
;; Boston, MA 02111-1307, USA gnu@gnu.org
;;; Commentary:
;;
;; Unit tests for (debugging statprof).
;;
;;; Code:
(define-module (test-suite test-statprof)
#:use-module (test-suite lib)
#:use-module (system base compile)
#:use-module (srfi srfi-1)
#:use-module (statprof))
(pass-if "statistical sample counts within expected range"
(let ()
;; 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
;; the moment).
;; 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)))
#: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 80000)
(funcs (circular-list (make-func) (make-func) (make-func))))
;; 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 ((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))))))))
(pass-if "accurate call counting"
(let ()
;; 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
(compile '(lambda (n)
(simple-format #f "FOO ~A\n" (+ n n)))))
;; Run test.
(statprof-reset 0 50000 #t #f)
(statprof-start)
(let loop ((x num-calls))
(cond
((positive? x)
(do-nothing x)
(loop (- x 1))
#t)))
(statprof-stop)
;; Check result.
(let ((proc-data (statprof-proc-call-data do-nothing)))
(and proc-data
(= (statprof-call-data-calls proc-data)
num-calls))))))
|
