aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2023-10-18 05:21:21 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2023-10-18 05:21:21 +0200
commita2b6d4fe6259e07a1bee7f497966242124718a1d (patch)
tree5fd7ab651c95b592139ef4f7cc6f099cfb0dab16
parentAdd commentary to (web http dav) (diff)
downloadcalp-a2b6d4fe6259e07a1bee7f497966242124718a1d.tar.gz
calp-a2b6d4fe6259e07a1bee7f497966242124718a1d.tar.xz
Include non-touched file in coverage report.
The recent rewrite where coverage reports where limited to explictly mentioned files lead to non-covered files being completely left out. This re-introduces them with 0% coverage, noted on the second line (to hopefully indicate that something is amiss).
-rwxr-xr-xtestrunner.scm32
1 files changed, 31 insertions, 1 deletions
diff --git a/testrunner.scm b/testrunner.scm
index 7ae577f7..014dd096 100755
--- a/testrunner.scm
+++ b/testrunner.scm
@@ -33,6 +33,8 @@ exec "$GUILE" --debug --no-auto-compile -e main -s "$0" "$@"
(hnh test util)
((hnh util io) :select (displayln))
(crypto)
+ (ice-9 popen)
+ (ice-9 rdelim)
(ice-9 getopt-long)
(ice-9 control)
(ice-9 format))
@@ -273,6 +275,22 @@ Flags:
(read port)))
+;;; TODO replace this with native Guile variant
+(define (all-files-under-dir dir)
+ (let ((pipe (open-pipe*
+ OPEN_READ
+ "find" dir
+ "-type" "f"
+ "-name" "*.scm"
+ "-exec" "realpath" "--zero" "{}" ";")))
+ (let loop ((done '()))
+ (let ((line (read-delimited "\0" pipe)))
+ (if (eof-object? line)
+ (begin
+ (close-pipe pipe)
+ done)
+ (loop (cons line done)))))))
+
(define (main args)
(define options (getopt-long args option-spec))
@@ -347,11 +365,23 @@ Flags:
(stack->list results))))))
+ (define uncovered-files
+ (lset-difference! string=?
+ (all-files-under-dir "module/")
+ (map filename merged-coverages)))
+
(unless (null? merged-coverages)
(with-output-to-file coverage
(lambda ()
(display "TN:") (newline)
- (for-each output-coverage merged-coverages))))
+ (for-each output-coverage merged-coverages)
+ (for-each output-coverage
+ (map (lambda (filename)
+ (coverage-info filename: filename
+ lines: '((2 . 0))
+ total-lines: 1
+ hit-lines: 0))
+ uncovered-files)))))
(format #t "~%== Gathered errors ==~%")
(let loop ()