Commit | Line | Data |
---|---|---|
500f6a47 | 1 | ;; guile-lib -*- scheme -*- |
96039191 | 2 | ;; Copyright (C) 2004, 2009, 2010, 2014 Andy Wingo <wingo at pobox dot com> |
500f6a47 AW |
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 | ||
ea3cef04 LC |
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 | ||
500f6a47 | 48 | (pass-if "statistical sample counts within expected range" |
ea3cef04 | 49 | (when-implemented |
500f6a47 AW |
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) | |
a8d7fba8 LC |
57 | ;; Disable partial evaluation so that `(+ i i)' doesn't get |
58 | ;; stripped. | |
500f6a47 | 59 | (compile '(lambda (n) |
6f0e534f LC |
60 | (do ((i 0 (+ i 1))) ((= 200 i)) (+ i i))) |
61 | #:opts '(#:partial-eval? #f))) | |
500f6a47 AW |
62 | (define run-test |
63 | (compile '(lambda (num-calls funcs) | |
6f0e534f LC |
64 | (let loop ((x num-calls) (funcs funcs)) |
65 | (cond | |
66 | ((positive? x) | |
67 | ((car funcs) x) | |
68 | (loop (- x 1) (cdr funcs)))))))) | |
69 | ||
96039191 | 70 | (let ((num-calls 200000) |
6f0e534f | 71 | (funcs (circular-list (make-func) (make-func) (make-func)))) |
500f6a47 | 72 | |
f9c1b827 LC |
73 | ;; Run test. 20000 us == 200 Hz. |
74 | (statprof-reset 0 20000 #f #f) | |
500f6a47 AW |
75 | (statprof-start) |
76 | (run-test num-calls funcs) | |
77 | (statprof-stop) | |
78 | ||
6f0e534f LC |
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))) | |
96039191 AW |
85 | (expected (/ (apply + samples) 3.0)) |
86 | (diffs (map (lambda (x) (abs (- x expected))) | |
6f0e534f LC |
87 | samples)) |
88 | (max-diff (apply max diffs))) | |
89 | ||
96039191 AW |
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)))) | |
500f6a47 | 98 | |
6f0e534f LC |
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)))))))) | |
500f6a47 AW |
103 | |
104 | (pass-if "accurate call counting" | |
ea3cef04 | 105 | (when-implemented |
500f6a47 AW |
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 | ||
f165bf93 AW |
110 | (define do-nothing |
111 | (compile '(lambda (n) | |
112 | (simple-format #f "FOO ~A\n" (+ n n))))) | |
500f6a47 | 113 | |
500f6a47 AW |
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 | ||
500f6a47 AW |
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)))))) |