dmbcs/guile
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

coverage: Add tests for `case-lambda'.

Browse source 
* test-suite/tests/coverage.test
  ("line-execution-counts")["case-lambda"]: New test.
  ("procedure-execution-count")["case-lambda"]: New test.
This commit is contained in:
Ludovic Courtès 2011-10-15 17:05:23 +02:00
commit 0129130439
1 changed files with 22 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

22
test-suite/tests/coverage.test
View file

@ -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)