Commit | Line | Data |
---|---|---|
500f6a47 | 1 | ;; guile-lib -*- scheme -*- |
f165bf93 | 2 | ;; Copyright (C) 2004, 2009, 2010 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 | ||
500f6a47 AW |
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) | |
a8d7fba8 LC |
43 | ;; Disable partial evaluation so that `(+ i i)' doesn't get |
44 | ;; stripped. | |
500f6a47 | 45 | (compile '(lambda (n) |
a8d7fba8 LC |
46 | (do ((i 0 (+ i 1))) ((= 200 i)) (+ i i))) |
47 | #:opts '(#:partial-eval? #f))) | |
500f6a47 AW |
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 | ||
a8d7fba8 | 56 | (let ((num-calls 80000) |
500f6a47 AW |
57 | (funcs (circular-list (make-func) (make-func) (make-func)))) |
58 | ||
f9c1b827 LC |
59 | ;; Run test. 20000 us == 200 Hz. |
60 | (statprof-reset 0 20000 #f #f) | |
500f6a47 AW |
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) | |
b3da54d1 | 78 | ;; don't stop the test suite for what statistically is |
500f6a47 AW |
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 | ||
f165bf93 AW |
88 | (define do-nothing |
89 | (compile '(lambda (n) | |
90 | (simple-format #f "FOO ~A\n" (+ n n))))) | |
500f6a47 | 91 | |
500f6a47 AW |
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 | ||
500f6a47 AW |
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)))))) |