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 | ||
cdcba5b2 LC |
48 | (pass-if-equal "return values" |
49 | '(42 77) | |
50 | (call-with-values | |
51 | (lambda () | |
52 | (with-output-to-port (%make-void-port "w") | |
53 | (lambda () | |
54 | (with-statprof | |
55 | (let loop ((i 10000)) | |
56 | (if (zero? i) | |
57 | (values 42 77) | |
58 | (loop (1- i)))))))) | |
59 | list)) | |
60 | ||
500f6a47 | 61 | (pass-if "statistical sample counts within expected range" |
ea3cef04 | 62 | (when-implemented |
500f6a47 AW |
63 | ;; test to see that if we call 3 identical functions equally, they |
64 | ;; show up equally in the call count, +/- 30%. it's a big range, and | |
65 | ;; I tried to do something more statistically valid, but failed (for | |
66 | ;; the moment). | |
67 | ||
68 | ;; make sure these are compiled so we're not swamped in `eval' | |
69 | (define (make-func) | |
a8d7fba8 LC |
70 | ;; Disable partial evaluation so that `(+ i i)' doesn't get |
71 | ;; stripped. | |
500f6a47 | 72 | (compile '(lambda (n) |
6f0e534f LC |
73 | (do ((i 0 (+ i 1))) ((= 200 i)) (+ i i))) |
74 | #:opts '(#:partial-eval? #f))) | |
500f6a47 AW |
75 | (define run-test |
76 | (compile '(lambda (num-calls funcs) | |
6f0e534f LC |
77 | (let loop ((x num-calls) (funcs funcs)) |
78 | (cond | |
79 | ((positive? x) | |
80 | ((car funcs) x) | |
81 | (loop (- x 1) (cdr funcs)))))))) | |
82 | ||
96039191 | 83 | (let ((num-calls 200000) |
6f0e534f | 84 | (funcs (circular-list (make-func) (make-func) (make-func)))) |
500f6a47 | 85 | |
f9c1b827 LC |
86 | ;; Run test. 20000 us == 200 Hz. |
87 | (statprof-reset 0 20000 #f #f) | |
500f6a47 AW |
88 | (statprof-start) |
89 | (run-test num-calls funcs) | |
90 | (statprof-stop) | |
91 | ||
6f0e534f LC |
92 | (let ((a-data (statprof-proc-call-data (car funcs))) |
93 | (b-data (statprof-proc-call-data (cadr funcs))) | |
94 | (c-data (statprof-proc-call-data (caddr funcs)))) | |
95 | (if (and a-data b-data c-data) | |
96 | (let* ((samples (map statprof-call-data-cum-samples | |
97 | (list a-data b-data c-data))) | |
96039191 AW |
98 | (expected (/ (apply + samples) 3.0)) |
99 | (diffs (map (lambda (x) (abs (- x expected))) | |
6f0e534f LC |
100 | samples)) |
101 | (max-diff (apply max diffs))) | |
102 | ||
96039191 AW |
103 | (or (< max-diff (sqrt expected)) |
104 | ;; don't stop the test suite for what statistically is | |
105 | ;; bound to happen. | |
106 | (begin | |
107 | (format (current-warning-port) | |
108 | ";;; warning: max diff ~a > (sqrt ~a)\n" | |
109 | max-diff expected) | |
110 | (throw 'unresolved)))) | |
500f6a47 | 111 | |
6f0e534f LC |
112 | ;; Samples were not collected for at least one of the |
113 | ;; functions, possibly because NUM-CALLS is too low compared | |
114 | ;; to the CPU speed. | |
115 | (throw 'unresolved (pk (list a-data b-data c-data)))))))) | |
500f6a47 AW |
116 | |
117 | (pass-if "accurate call counting" | |
ea3cef04 | 118 | (when-implemented |
500f6a47 AW |
119 | ;; Test to see that if we call a function N times while the profiler |
120 | ;; is active, it shows up N times. | |
121 | (let ((num-calls 200)) | |
122 | ||
f165bf93 AW |
123 | (define do-nothing |
124 | (compile '(lambda (n) | |
125 | (simple-format #f "FOO ~A\n" (+ n n))))) | |
500f6a47 | 126 | |
500f6a47 AW |
127 | ;; Run test. |
128 | (statprof-reset 0 50000 #t #f) | |
129 | (statprof-start) | |
130 | (let loop ((x num-calls)) | |
131 | (cond | |
132 | ((positive? x) | |
133 | (do-nothing x) | |
134 | (loop (- x 1)) | |
135 | #t))) | |
136 | (statprof-stop) | |
137 | ||
500f6a47 AW |
138 | ;; Check result. |
139 | (let ((proc-data (statprof-proc-call-data do-nothing))) | |
140 | (and proc-data | |
141 | (= (statprof-call-data-calls proc-data) | |
142 | num-calls)))))) |