diff options
author | Ludovic Courtès <ludo@gnu.org> | 2011-10-15 17:05:23 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2011-10-15 17:43:27 +0200 |
commit | 0129130439548d4a988af89302e91d61266959f8 (patch) | |
tree | f23d4ccf859f2a6e193299e6c54103ec0189197b | |
parent | 43e53d64ca34ef7dd6b7f135114c72c9b39b399e (diff) | |
download | guile-0129130439548d4a988af89302e91d61266959f8.tar.gz |
coverage: Add tests for `case-lambda'.
* test-suite/tests/coverage.test
("line-execution-counts")["case-lambda"]: New test.
("procedure-execution-count")["case-lambda"]: New test.
-rw-r--r-- | test-suite/tests/coverage.test | 22 |
1 files changed, 22 insertions, 0 deletions
diff --git a/test-suite/tests/coverage.test b/test-suite/tests/coverage.test index 7e38dafb9..4ac404344 100644 --- a/test-suite/tests/coverage.test +++ b/test-suite/tests/coverage.test @@ -162,6 +162,18 @@ (else #f)))) counts)))))) + (pass-if "case-lambda" + (let ((proc (code "cl.scm" "(case-lambda ;; 0 + ((x) (+ x 3)) ;; 1 + ((x y) (+ x y))) ;; 2"))) + (let-values (((data result) + (with-code-coverage %test-vm + (lambda () + (+ (proc 1) (proc 2 3)))))) + (let ((counts (line-execution-counts data "cl.scm"))) + (and (pair? counts) + (lset= equal? '((0 . 2) (1 . 1) (2 . 1)) counts)))))) + (pass-if "all code on one line" ;; There are several proc/IP pairs pointing to this source line, yet the hit ;; count for the line should be 1. @@ -185,6 +197,16 @@ (= 3 result) (= (procedure-execution-count data proc) 2))))) + (pass-if "case-lambda" + (let ((proc (code "foo.scm" "(case-lambda ((x) x) ((x y) (+ x y)))"))) + (let-values (((data result) + (with-code-coverage %test-vm + (lambda () + (+ (proc 1) (proc 2 3)))))) + (and (coverage-data? data) + (= 6 result) + (= (procedure-execution-count data proc) 2))))) + (pass-if "never" (let ((proc (code "foo.scm" "(lambda (x y) x)"))) (let-values (((data result) |