From 36b5e394072c94b062a69a6d77b418e16ce70fce Mon Sep 17 00:00:00 2001 From: =?utf8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 2 May 2010 14:17:41 +0200 Subject: [PATCH] Add (system vm coverage). * module/system/vm/coverage.scm: New file. * module/Makefile.am (SYSTEM_SOURCES): Add `system/vm/coverage.scm'. * test-suite/guile-test (main): Use (system vm coverage). Handle `--coverage' and `-c'. * test-suite/tests/coverage.test: New file. * test-suite/Makefile.am (SCM_TESTS): Add `tests/coverage.test'. * doc/ref/Makefile.am (guile_TEXINFOS): Add `api-coverage.texi'. * doc/ref/api-coverage.texi: New file. * doc/ref/guile.texi (API Reference): Include it. --- doc/ref/Makefile.am | 1 + doc/ref/api-coverage.texi | 81 ++++++++ doc/ref/guile.texi | 2 + module/Makefile.am | 1 + module/system/vm/coverage.scm | 362 +++++++++++++++++++++++++++++++++ test-suite/Makefile.am | 1 + test-suite/guile-test | 24 ++- test-suite/tests/coverage.test | 201 ++++++++++++++++++ 8 files changed, 668 insertions(+), 5 deletions(-) create mode 100644 doc/ref/api-coverage.texi create mode 100644 module/system/vm/coverage.scm create mode 100644 test-suite/tests/coverage.test diff --git a/doc/ref/Makefile.am b/doc/ref/Makefile.am index 1a933db50..60146a3a9 100644 --- a/doc/ref/Makefile.am +++ b/doc/ref/Makefile.am @@ -51,6 +51,7 @@ guile_TEXINFOS = preface.texi \ api-options.texi \ api-i18n.texi \ api-debug.texi \ + api-coverage.texi \ scheme-reading.texi \ scheme-indices.texi \ slib.texi \ diff --git a/doc/ref/api-coverage.texi b/doc/ref/api-coverage.texi new file mode 100644 index 000000000..123e1d354 --- /dev/null +++ b/doc/ref/api-coverage.texi @@ -0,0 +1,81 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 2010 Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + + +@page +@node Code Coverage +@section Code Coverage Reports + +@cindex code coverage +@cindex coverage +When writing a test suite for a program or library, it is desirable to know what +part of the code is @dfn{covered} by the test suite. The @code{(system vm +coverage)} module provides tools to gather code coverage data and to present +them, as detailed below. + +@deffn {Scheme Procedure} with-code-coverage vm thunk +Run @var{thunk}, a zero-argument procedure, using @var{vm}; instrument @var{vm} +to collect code coverage data. Return code coverage data and the values +returned by @var{thunk}. +@end deffn + +@deffn {Scheme Procedure} coverage-data? obj +Return @code{#t} if @var{obj} is a @dfn{coverage data} object as returned by +@code{with-code-coverage}. +@end deffn + +@deffn {Scheme Procedure} coverage-data->lcov data port #:key modules +Traverse code coverage information @var{data}, as obtained with +@code{with-code-coverage}, and write coverage information to port in the +@code{.info} format used by @url{http://ltp.sourceforge.net/coverage/lcov.php, +LCOV}. The report will include all of @var{modules} (or, by default, all the +currently loaded modules) even if their code was not executed. + +The generated data can be fed to LCOV's @command{genhtml} command to produce an +HTML report, which aids coverage data visualization. +@end deffn + +Here's an example use: + +@example +(use-modules (system vm coverage) + (system vm vm)) + +(call-with-values (lambda () + (with-code-coverage (the-vm) + (lambda () + (do-something-tricky)))) + (lambda (data result) + (let ((port (open-output-file "lcov.info"))) + (coverage-data->lcov data port) + (close file)))) +@end example + +In addition, the module provides low-level procedures that would make it +possible to write other user interfaces to the coverage data. + +@deffn {Scheme Procedures} instrumented-source-files data +Return the list of ``instrumented'' source files, i.e., source files whose +code was loaded at the time @var{data} was collected. +@end deffn + +@deffn {Scheme Procedures} line-execution-counts data file +Return a list of line number/execution count pairs for @var{file}, or +@code{#f} if @var{file} is not among the files covered by @var{data}. This +includes lines with zero count. +@end deffn + +@deffn {Scheme Procedures} instrumented/executed-lines data file +Return the number of instrumented and the number of executed source lines +in @var{file} according to @var{data}. +@end deffn + +@deffn {Scheme Procedures} procedure-execution-count data proc +Return the number of times @var{proc}'s code was executed, according to +@var{data}, or @code{#f} if @var{proc} was not executed. When @var{proc} +is a closure, the number of times its code was executed is returned, not +the number of times this code associated with this particular closure was +executed. +@end deffn diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi index a3a212a7a..27d6c7b7f 100644 --- a/doc/ref/guile.texi +++ b/doc/ref/guile.texi @@ -312,6 +312,7 @@ available through both Scheme and C interfaces. * Other Languages:: Emacs Lisp, ECMAScript, and more. * Internationalization:: Support for gettext, etc. * Debugging:: Debugging infrastructure and Scheme interface. +* Code Coverage:: Gathering code coverage data. @end menu @include api-overview.texi @@ -339,6 +340,7 @@ available through both Scheme and C interfaces. @include api-languages.texi @include api-i18n.texi @include api-debug.texi +@include api-coverage.texi @node Guile Modules @chapter Guile Modules diff --git a/module/Makefile.am b/module/Makefile.am index 2410cb2c6..cbe945f95 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -278,6 +278,7 @@ OOP_SOURCES = \ SYSTEM_SOURCES = \ system/vm/inspect.scm \ + system/vm/coverage.scm \ system/vm/debug.scm \ system/vm/frame.scm \ system/vm/instruction.scm \ diff --git a/module/system/vm/coverage.scm b/module/system/vm/coverage.scm new file mode 100644 index 000000000..260097491 --- /dev/null +++ b/module/system/vm/coverage.scm @@ -0,0 +1,362 @@ +;;; -*- mode: scheme; coding: utf-8; -*- +;;; +;;; Copyright (C) 2010 Free Software Foundation, Inc. +;;; +;;; This library is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Lesser General Public +;;; License as published by the Free Software Foundation; either +;;; version 3 of the License, or (at your option) any later version. +;;; +;;; This library is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Lesser General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with this library; if not, write to the Free Software +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +(define-module (system vm coverage) + #:use-module (system vm vm) + #:use-module (system vm frame) + #:use-module (system vm program) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:export (with-code-coverage + coverage-data? + instrumented-source-files + instrumented/executed-lines + line-execution-counts + procedure-execution-count + coverage-data->lcov)) + +;;; Author: Ludovic Courtès +;;; +;;; Commentary: +;;; +;;; This module provides support to gather code coverage data by instrumenting +;;; the VM. +;;; +;;; Code: + + +;;; +;;; Gathering coverage data. +;;; + +(define (hashq-proc proc n) + ;; Return the hash of PROC's objcode. + (hashq (program-objcode proc) n)) + +(define (assq-proc proc alist) + ;; Instead of really looking for PROC in ALIST, look for the objcode of PROC. + ;; IOW the alist is indexed by procedures, not objcodes, but those procedures + ;; are taken as an arbitrary representative of all the procedures (closures) + ;; sharing that objcode. This can significantly reduce memory consumption. + (let ((code (program-objcode proc))) + (find (lambda (pair) + (eq? code (program-objcode (car pair)))) + alist))) + +(define (with-code-coverage vm thunk) + "Run THUNK, a zero-argument procedure, using VM; instrument VM to collect code +coverage data. Return code coverage data and the values returned by THUNK." + + (define procedure->ip-counts + ;; Mapping from procedures to hash tables; said hash tables map instruction + ;; pointers to the number of times they were executed. + (make-hash-table 500)) + + (define (collect! frame) + ;; Update PROCEDURE->IP-COUNTS with info from FRAME. + (let* ((proc (frame-procedure frame)) + (ip (frame-instruction-pointer frame)) + (proc-entry (hashx-create-handle! hashq-proc assq-proc + procedure->ip-counts proc #f))) + (let loop () + (define ip-counts (cdr proc-entry)) + (if ip-counts + (let ((ip-entry (hashv-create-handle! ip-counts ip 0))) + (set-cdr! ip-entry (+ (cdr ip-entry) 1))) + (begin + (set-cdr! proc-entry (make-hash-table)) + (loop)))))) + + (call-with-values (lambda () + (let ((level (vm-trace-level vm)) + (hook (vm-next-hook vm))) + (dynamic-wind + (lambda () + (set-vm-trace-level! vm (+ level 1)) + (add-hook! hook collect!)) + (lambda () + (vm-apply vm thunk '())) + (lambda () + (set-vm-trace-level! vm level) + (remove-hook! hook collect!))))) + (lambda args + (apply values (make-coverage-data procedure->ip-counts) args)))) + + +;;; +;;; Coverage data summary. +;;; + +(define-record-type + (%make-coverage-data procedure->ip-counts + procedure->sources + file->procedures + file->line-counts) + coverage-data? + + ;; Mapping from procedures to hash tables; said hash tables map instruction + ;; pointers to the number of times they were executed. + (procedure->ip-counts data-procedure->ip-counts) + + ;; Mapping from procedures to the result of `program-sources'. + (procedure->sources data-procedure->sources) + + ;; Mapping from source file names to lists of procedures defined in the file. + (file->procedures data-file->procedures) + + ;; Mapping from file names to hash tables, which in turn map from line numbers + ;; to execution counts. + (file->line-counts data-file->line-counts)) + + +(define (make-coverage-data procedure->ip-counts) + ;; Return a `coverage-data' object based on the coverage data available in + ;; PROCEDURE->IP-COUNTS. Precompute the other hash tables that make up + ;; `coverage-data' objects. + (let* ((procedure->sources (make-hash-table 500)) + (file->procedures (make-hash-table 100)) + (file->line-counts (make-hash-table 100)) + (data (%make-coverage-data procedure->ip-counts + procedure->sources + file->procedures + file->line-counts))) + (define (increment-execution-count! file line count) + ;; Make the execution count of FILE:LINE the maximum of its current value + ;; and COUNT. This is so that LINE's execution count is correct when + ;; several instruction pointers map to LINE. + (let ((file-entry (hash-create-handle! file->line-counts file #f))) + (if (not (cdr file-entry)) + (set-cdr! file-entry (make-hash-table 500))) + (let ((line-entry (hashv-create-handle! (cdr file-entry) line 0))) + (set-cdr! line-entry (max (cdr line-entry) count))))) + + ;; Update execution counts for procs that were executed. + (hash-for-each (lambda (proc ip-counts) + (let* ((sources (program-sources* data proc)) + (file (and (pair? sources) + (source:file (car sources))))) + (and file + (begin + ;; Add a zero count for all IPs in SOURCES and in + ;; the sources of procedures closed over by PROC. + (for-each + (lambda (source) + (let ((file (source:file source)) + (line (source:line source))) + (increment-execution-count! file line 0))) + (append-map (cut program-sources* data <>) + (closed-over-procedures proc))) + + ;; Add the actual execution count collected. + (hash-for-each + (lambda (ip count) + (let ((line (closest-source-line sources ip))) + (increment-execution-count! file line count))) + ip-counts))))) + procedure->ip-counts) + + ;; Set the execution count to zero for procedures loaded and not executed. + ;; FIXME: Traversing thousands of procedures here is inefficient. + (for-each (lambda (proc) + (and (not (hashq-ref procedure->sources proc)) + (for-each (lambda (proc) + (let* ((sources (program-sources* data proc)) + (file (and (pair? sources) + (source:file (car sources))))) + (and file + (for-each + (lambda (ip) + (let ((line (closest-source-line sources ip))) + (increment-execution-count! file line 0))) + (map source:addr sources))))) + (closed-over-procedures proc)))) + (append-map module-procedures (loaded-modules))) + + data)) + +(define (procedure-execution-count data proc) + "Return the number of times PROC's code was executed, according to DATA, or #f +if PROC was not executed. When PROC is a closure, the number of times its code +was executed is returned, not the number of times this code associated with this +particular closure was executed." + (and=> (hashx-ref hashq-proc assq-proc + (data-procedure->ip-counts data) proc) + (let ((sources (program-sources* data proc))) + (lambda (ip-counts) + (let ((entry-ip (source:addr (car sources)))) ;; FIXME: broken with lambda* + (hashv-ref ip-counts entry-ip 0)))))) + +(define (program-sources* data proc) + ;; A memoizing version of `program-sources'. + (or (hashq-ref (data-procedure->sources data) proc) + (and (program? proc) + (let ((sources (program-sources proc)) + (p->s (data-procedure->sources data)) + (f->p (data-file->procedures data))) + (if (pair? sources) + (let* ((file (source:file (car sources))) + (entry (hash-create-handle! f->p file '()))) + (hashq-set! p->s proc sources) + (set-cdr! entry (cons proc (cdr entry))) + sources) + sources))))) + +(define (file-procedures data file) + ;; Return the list of globally bound procedures defined in FILE. + (hash-ref (data-file->procedures data) file '())) + +(define (instrumented/executed-lines data file) + "Return the number of instrumented and the number of executed source lines in +FILE according to DATA." + (define instr+exec + (and=> (hash-ref (data-file->line-counts data) file) + (lambda (line-counts) + (hash-fold (lambda (line count instr+exec) + (let ((instr (car instr+exec)) + (exec (cdr instr+exec))) + (cons (+ 1 instr) + (if (> count 0) + (+ 1 exec) + exec)))) + '(0 . 0) + line-counts)))) + + (values (car instr+exec) (cdr instr+exec))) + +(define (line-execution-counts data file) + "Return a list of line number/execution count pairs for FILE, or #f if FILE +is not among the files covered by DATA." + (and=> (hash-ref (data-file->line-counts data) file) + (lambda (line-counts) + (hash-fold alist-cons '() line-counts)))) + +(define (instrumented-source-files data) + "Return the list of `instrumented' source files, i.e., source files whose code +was loaded at the time DATA was collected." + (hash-fold (lambda (file counts files) + (cons file files)) + '() + (data-file->line-counts data))) + + +;;; +;;; Helpers. +;;; + +(define (loaded-modules) + ;; Return the list of all the modules currently loaded. + (define seen (make-hash-table)) + + (let loop ((modules (module-submodules (resolve-module '() #f))) + (result '())) + (hash-fold (lambda (name module result) + (if (hashq-ref seen module) + result + (begin + (hashq-set! seen module #t) + (loop (module-submodules module) + (cons module result))))) + result + modules))) + +(define (module-procedures module) + ;; Return the list of procedures bound globally in MODULE. + (hash-fold (lambda (binding var result) + (if (variable-bound? var) + (let ((value (variable-ref var))) + (if (procedure? value) + (cons value result) + result)) + result)) + '() + (module-obarray module))) + +(define (closest-source-line sources ip) + ;; Given SOURCES, as returned by `program-sources' for a given procedure, + ;; return the source line of code that is the closest to IP. This is similar + ;; to what `program-source' does. + (let loop ((sources sources) + (line (and (pair? sources) (source:line (car sources))))) + (if (null? sources) + line + (let ((source (car sources))) + (if (> (source:addr source) ip) + line + (loop (cdr sources) (source:line source))))))) + +(define (closed-over-procedures proc) + ;; Return the list of procedures PROC closes over, PROC included. + (let loop ((proc proc) + (result '())) + (if (and (program? proc) (not (memq proc result))) + (fold loop (cons proc result) + (append (vector->list (or (program-objects proc) #())) + (program-free-variables proc))) + result))) + + +;;; +;;; LCOV output. +;;; + +(define* (coverage-data->lcov data port) + "Traverse code coverage information DATA, as obtained with +`with-code-coverage', and write coverage information in the LCOV format to PORT. +The report will include all the modules loaded at the time coverage data was +gathered, even if their code was not executed." + + (define (dump-function proc) + ;; Dump source location and basic coverage data for PROC. + (and (program? proc) + (let ((sources (program-sources* data proc))) + (and (pair? sources) + (let* ((line (source:line (car sources))) + (name (or (procedure-name proc) + (format #f "anonymous-l~a" (+ 1 line))))) + (format port "FN:~A,~A~%" (+ 1 line) name) + (and=> (procedure-execution-count data proc) + (lambda (count) + (format port "FNDA:~A,~A~%" count name)))))))) + + ;; Output per-file coverage data. + (format port "TN:~%") + (for-each (lambda (file) + (let ((procs (file-procedures data file)) + (path (search-path %load-path file))) + (if (string? path) + (begin + (format port "SF:~A~%" path) + (for-each dump-function procs) + (for-each (lambda (line+count) + (let ((line (car line+count)) + (count (cdr line+count))) + (format port "DA:~A,~A~%" + (+ 1 line) count))) + (line-execution-counts data file)) + (let-values (((instr exec) + (instrumented/executed-lines data file))) + (format port "LH: ~A~%" exec) + (format port "LF: ~A~%" instr)) + (format port "end_of_record~%")) + (begin + (format (current-error-port) + "skipping unknown source file: ~a~%" + file))))) + (instrumented-source-files data))) diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index 4444be498..eed9618d4 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -35,6 +35,7 @@ SCM_TESTS = tests/00-initial-env.test \ tests/common-list.test \ tests/control.test \ tests/continuations.test \ + tests/coverage.test \ tests/curried-definitions.test \ tests/ecmascript.test \ tests/elisp.test \ diff --git a/test-suite/guile-test b/test-suite/guile-test index 0031bbf4c..c114ad66a 100755 --- a/test-suite/guile-test +++ b/test-suite/guile-test @@ -85,6 +85,9 @@ :use-module (ice-9 getopt-long) :use-module (ice-9 and-let-star) :use-module (ice-9 rdelim) + :use-module (system vm coverage) + :use-module (srfi srfi-11) + :use-module (system vm vm) :export (main data-file-name test-file-name)) @@ -175,6 +178,8 @@ (log-file (single-char #\l) (value #t)) + (coverage + (single-char #\c)) (debug (single-char #\d)))))) (define (opt tag default) @@ -227,11 +232,20 @@ (set! global-pass #f))))) ;; Run the tests. - (for-each (lambda (test) - (display (string-append "Running " test "\n")) - (with-test-prefix test - (load (test-file-name test)))) - tests) + (let ((run-tests + (lambda () + (for-each (lambda (test) + (display (string-append "Running " test "\n")) + (with-test-prefix test + (load (test-file-name test)))) + tests)))) + (if (opt 'coverage #f) + (let-values (((coverage-data _) + (with-code-coverage (the-vm) run-tests))) + (let ((out (open-output-file "guile.info"))) + (coverage-data->lcov coverage-data out) + (close out))) + (run-tests))) ;; Display the final counts, both to the user and in the log ;; file. diff --git a/test-suite/tests/coverage.test b/test-suite/tests/coverage.test new file mode 100644 index 000000000..eefb7bb6c --- /dev/null +++ b/test-suite/tests/coverage.test @@ -0,0 +1,201 @@ +;;;; coverage.test --- Code coverage. -*- mode: scheme; coding: utf-8; -*- +;;;; +;;;; Copyright (C) 2010 Free Software Foundation, Inc. +;;;; +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 3 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +(define-module (test-coverage) + #:use-module (test-suite lib) + #:use-module (system vm coverage) + #:use-module (system vm vm) + #:use-module (system base compile) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11)) + +(define-syntax code + (syntax-rules () + ((_ filename snippet) + (let ((input (open-input-string snippet))) + (set-port-filename! input filename) + (read-enable 'positions) + (compile (read input)))))) + +(define %test-vm (make-vm)) + + +(with-test-prefix "instrumented/executed-lines" + + (pass-if "instr = exec" + (let ((proc (code "foo.scm" "(lambda (x y) ;; 0 + (+ x y)) ;; 1"))) + (let-values (((data result) + (with-code-coverage %test-vm + (lambda () (proc 1 2))))) + (and (coverage-data? data) + (= 3 result) + (let-values (((instr exec) + (instrumented/executed-lines data "foo.scm"))) + (and (= 2 instr) (= 2 exec))))))) + + (pass-if "instr >= exec" + (let ((proc (code "foo.scm" "(lambda (x y) ;; 0 + (if (> x y) ;; 1 + (begin ;; 2 + (display x) ;; 3 + (+ x y)))) ;; 4"))) + (let-values (((data result) + (with-code-coverage %test-vm + (lambda () (proc 1 2))))) + (and (coverage-data? data) + (let-values (((instr exec) + (instrumented/executed-lines data "foo.scm"))) + (and (> instr 0) (>= instr exec)))))))) + + +(with-test-prefix "line-execution-counts" + + (pass-if "once" + (let ((proc (code "bar.scm" "(lambda (x y) ;; 0 + (+ (/ x y) ;; 1 + (* x y))) ;; 2"))) + (let-values (((data result) + (with-code-coverage %test-vm + (lambda () (proc 1 2))))) + (let ((counts (line-execution-counts data "bar.scm"))) + (and (pair? counts) + (every (lambda (line+count) + (let ((line (car line+count)) + (count (cdr line+count))) + (and (>= line 0) + (<= line 2) + (= count 1)))) + counts)))))) + + (pass-if "several times" + (let ((proc (code "fooz.scm" "(lambda (x) ;; 0 + (format #f \"hello\") ;; 1 + (let loop ((x x)) ;; 2 + (cond ((> x 0) ;; 3 + (begin ;; 4 + (format #f \"~a\" x) + (loop (1- x)))) ;; 6 + ((= x 0) #t) ;; 7 + ((< x 0) 'never))))"))) + (let-values (((data result) + (with-code-coverage %test-vm + (lambda () (proc 77))))) + (let ((counts (line-execution-counts data "fooz.scm"))) + (and (pair? counts) + (every (lambda (line+count) + (let ((line (car line+count)) + (count (cdr line+count))) + (case line + ((0 1) (= count 1)) + ((2 3) (= count 78)) + ((4 5 6) (= count 77)) + ((7) (= count 1)) + ((8) (= count 0))))) + counts)))))) + + (pass-if "some" + (let ((proc (code "baz.scm" "(lambda (x y) ;; 0 + (if (> x y) ;; 1 + (begin ;; 2 + (display x) ;; 3 + (+ x y)) ;; 4 + (+ x y))) ;; 5"))) + (let-values (((data result) + (with-code-coverage %test-vm + (lambda () (proc 1 2))))) + (let ((counts (line-execution-counts data "baz.scm"))) + (and (pair? counts) + (every (lambda (line+count) + (let ((line (car line+count)) + (count (cdr line+count))) + (case line + ((0 1 5) (= count 1)) + ((2 3) (= count 0)) + ((4) #t) ;; the start of the `else' branch is + ;; attributed to line 4 + (else #f)))) + counts)))))) + + (pass-if "one proc hit, one proc unused" + (let ((proc (code "baz.scm" "(letrec ((even? (lambda (x) ;; 0 + (or (= x 0) ;; 1 + (not (odd? (1- x)))))) + (odd? (lambda (x) ;; 3 + (not (even? (1- x)))))) ;; 4 + even?)"))) + (let-values (((data result) + (with-code-coverage %test-vm + (lambda () (proc 0))))) + (let ((counts (line-execution-counts data "baz.scm"))) + (and (pair? counts) + (every (lambda (line+count) + (let ((line (car line+count)) + (count (cdr line+count))) + (case line + ((0 1) (= count 1)) + ((2 3 4) (= count 0)) + ((5) (= count 1)) + (else #f)))) + 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. + (let ((proc (code "one-liner.scm" + "(lambda (x y) (+ x y (* x y) (if (> x y) 1 2) (quotient y x)))"))) + (let-values (((data result) + (with-code-coverage %test-vm + (lambda () (proc 451 1884))))) + (let ((counts (line-execution-counts data "one-liner.scm"))) + (equal? counts '((0 . 1)))))))) + + +(with-test-prefix "procedure-execution-count" + + (pass-if "several times" + (let ((proc (code "foo.scm" "(lambda (x y) x)"))) + (let-values (((data result) + (with-code-coverage %test-vm + (lambda () (+ (proc 1 2) (proc 2 3)))))) + (and (coverage-data? data) + (= 3 result) + (= (procedure-execution-count data proc) 2))))) + + (pass-if "never" + (let ((proc (code "foo.scm" "(lambda (x y) x)"))) + (let-values (((data result) + (with-code-coverage %test-vm + (lambda () (+ 1 2))))) + (and (coverage-data? data) + (= 3 result) + (not (procedure-execution-count data proc))))))) + + +(with-test-prefix "instrumented-source-files" + + (pass-if "source files are listed as expected" + (let ((proc (code "chbouib.scm" "(lambda (x y) x)"))) + (let-values (((data result) + (with-code-coverage %test-vm + (lambda () (proc 1 2))))) + + (let ((files (map basename (instrumented-source-files data)))) + (and (member "boot-9.scm" files) + (member "chbouib.scm" files) + (not (member "foo.scm" files)))))))) -- 2.20.1