From 06e8658fcd603cf1d548e18d86a81dd8a3f59657 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Fri, 27 Oct 2023 16:17:44 +0200 Subject: Automatically mark all definitions as covered. Guile's coverage system often missed those. Explicitly adding coverage information make percentage go up! --- testrunner.scm | 81 +++++++++++++++++++++++++---------- tests/unit/coverage-supplement.scm | 86 +++++++++++++------------------------- 2 files changed, 88 insertions(+), 79 deletions(-) diff --git a/testrunner.scm b/testrunner.scm index 48ebc3df..2f6ca943 100755 --- a/testrunner.scm +++ b/testrunner.scm @@ -32,6 +32,7 @@ exec "$GUILE" --debug --no-auto-compile -e main -s "$0" "$@" (hnh test testrunner) (hnh test util) ((hnh util io) :select (displayln)) + (hnh module-introspection all-modules) (crypto) (ice-9 popen) (ice-9 rdelim) @@ -41,6 +42,15 @@ exec "$GUILE" --debug --no-auto-compile -e main -s "$0" "$@" +(define exemption-rxs + (list + ;; All definitions are ignored, since they quite often are missed + ;; (and don't really "run") + "\\(define(-(\\w|-)+[*]?)?\\s" + "read-hash-extend")) + + + (define-syntax-rule (begin-thread forms ...) (let ((thread (make-thread (lambda () forms ...)))) (thread-start! thread) @@ -279,22 +289,16 @@ Flags: lines: (map (lambda (l) (cons l 1)) lines)))))) (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))))))) +;; Return the line numbers of all lines which +;; contain an instance of the given regex +(define (matching-lines rx port) + (let loop ((lino 1) (hit '())) + (let ((line (read-line port))) + (if (eof-object? line) + hit + (if (regexp-exec rx line) + (loop (1+ lino) (cons lino hit)) + (loop (1+ lino) hit)))))) (define (main args) @@ -349,7 +353,23 @@ Flags: (unless (null? outdated-extra) (format #t "The following files have changed since their coverage") (format #t "exceptions were written. Please review:~%") - (for-each (compose displayln yellow) outdated-extra)) + (for-each (lambda (line) + (displayln + (yellow + (format #f "~a, expected SHA256: ~a" + (filename (cdr line)) + (car line))))) + outdated-extra)) + + (define coverage-exemptions + (let ((rx (make-regexp (string-join exemption-rxs "|" 'infix)))) + (map (lambda (filename) + (coverage-info + filename: (realpath filename) + lines: (map (lambda (l) (cons l 1)) + (call-with-input-file filename + (lambda (port) (matching-lines rx port)))))) + (all-files-under-directory "module" ".scm")))) ((@ (hnh util exceptions) warnings-are-errors) #t) @@ -364,16 +384,31 @@ Flags: (option-ref options 'threads "1")))))) (test-end "Universe") - (define merged-coverages - (map (lambda (group) (reduce merge-coverage #f (cdr group))) - (group-by filename (concatenate (cons (map cdr extra-coverage) - (stack->list results)))))) + (define expected-files (concatenate (cons (map cdr extra-coverage) + (stack->list results)))) (define uncovered-files (lset-difference! string=? - (all-files-under-dir "module/") - (map filename merged-coverages))) + (map realpath (all-files-under-directory "module" ".scm")) + (map filename expected-files))) + + (define merged-coverages + (map (lambda (group) (reduce merge-coverage #f (cdr group))) + (group-by filename + (append + expected-files + ;; Remove totally uncovered files from the + ;; excepmption list. Otherwise they would + ;; (accidentally) get a really high coverage + ;; percentage, instead of 0%. + + ;; TODO possibly also remove vendored files, + ;; Locking them to 1/1 lines covered (line 2). + (remove (lambda (entry) (member (filename entry) + uncovered-files)) + coverage-exemptions))))) + (unless (null? merged-coverages) (with-output-to-file coverage diff --git a/tests/unit/coverage-supplement.scm b/tests/unit/coverage-supplement.scm index b8cea855..9b4e5a0e 100644 --- a/tests/unit/coverage-supplement.scm +++ b/tests/unit/coverage-supplement.scm @@ -8,111 +8,74 @@ ;;; - The sha256-sum of that file ;;; - Any number of lines which should be marked as covered. ( - ("module/hnh/util/atomic-queue.scm" - "40c0e0feb77392e3eb1f6ab6136cc116aeeded6030eea7db6688901df5ed021d" - 1 18) - ("module/hnh/util/atomic-stack.scm" - "147b45d2216c378c35d5c3ed0228be393b6c287f2a5515802928040f2087378e" - 1 13 29) ("module/hnh/util/type.scm" "f670542b9b404125224fd4c702be99e2c1c3fd55d862b18228e8772264ef3189" - 1 ; Module declaration 12 34 44 46 ; Macros 53) ; false? == not - ;; File is not tested at all, since it's mearly a "header" file. - ;; TODO possibly actually test extension loading, since it should - ;; fail gracefully when library is not available. - ("module/graphviz.scm" - "5ff20a55098973fcc8552cd897e779eaf01dc3d4909f8d23be47d317987d8e95" - 18 82 84) + ("module/base64.scm" "4614855f6cfedc20041e7094989e817f2c2c5ef85fb5f8322d915101c0aab53c" - 1 ; module declaration - 23 24 25 26 27 29 ; internal lookup table, used by everything so tested implicitly + 23 24 25 26 27 ; internal lookup table, used by everything so tested implicitly 53 54 55 56 ; internal helper function, tested implictly ) + ("module/text/util.scm" "271a5f7740aa6e378e7fda2da4725171dc50a2e4a790e9529fceed19a747e775" - 5 ; (Module declaration 52 ; else "keyword" apparently missed ) + ("module/vcomponent/duration.scm" "c83a2750964c2362af5043f33b435a792f62007d847f543e78a8f2550757e010" ;; Unreachable code, but fail faster 113 114 115 118 119 120 121 ) - ("module/calp.scm" - "873a191bc7122e59e3d60fb0f075dfa73fd8cc5ae0f3cb51932b24a0497ceeb1" - 1 ; Modudule declaration - 5 ; Version number (global variables are missed by the coverage) - ) + ("module/crypto.scm" "9e157f5b53e923e7925b0e53118a4789b55712120427b73c4c3c9561e2c48718" - 1 ; Module declaration 8 ; dynamic link - 10 11 12 13 14 ; constants 16 17 18 19 ; primitive sha256 procedure ) + ("module/datetime.scm" "67eb46283a4097e8400322ab6434518a2455ca630e163238b5839c2bf25c9ac7" - 1 - 159 160 161 162 163 164 165 ; week day declarations - ;; function declarations - 189 223 238 389 909 - 965 966 974 - 987 992 1011 1025 - 1231 - 1239 1280 - 923 924 925 ; read-hash-extend - ;; aliases - 958 959 960 - 1029 1031 1032 1034 1036 1037 1039 1041 1042 1044 1046 1047 - 1049 1051 1052 1054 1056 1057 1059 1061 1062 1064 1065 1067 1068 - ;; other 204 252 ; Would depend on local timezone 491 ; somehow not counted + 966 ) ("module/datetime/zic.scm" "2a8ac0fae3c88227b05a5978bff3e114745ea146e07a2751df67d16c1e8218f5" - 13 ; module declaration 66 ; syntax-rules - 171 223 ; function declaration ) - ("module/datetime/timespec.scm" - "9feb7a7a09d9942d72c6b14b9f230e7711a73ca518ec2dc209775354203d856b" - 6 ; module declaration - ) ("module/hnh/util.scm" "3f0bf90a45d6eecce1248b7509e1b050e5cadbe92b279fe5ef082c18baf3e6ca" - 1 72 73 74 ; conditional import - 77 ; syntax rules not covered:w - 289 ; != definition - 333 488 568 ; syntax rules + 77 ; syntax rules not covered + 333 568 ; syntax rules ) - ("module/srfi/srfi-41/util.scm" - "adb832b17f7ffe7c070fa3845f65283e850b14a07499d22715e16111f59ad88e" - 1) + ("module/calp/translation.scm" + "b7c0a82e1c109c339cf83438f39b6fc63219b51a3ad3ee35d58e70fb6a24c5c9" + 9 ; bindtextdomain + ) + ;; this file simply exports other things. There's nothing to test ("module/vcomponent.scm" "b1c58b3beb6f170d3c9f7d603b27231ccf696897736113095b446f437721a9e1" 2) + ;; get-terminal-size is basically impossible to test + ("module/vulgar/info.scm" + "f9f30fd2709a5614b986c697e089c36c7d5d8cd3824e6d4e2bac042d5c2c23e6" + 2) - ("module/calp/translation.scm" - "b7c0a82e1c109c339cf83438f39b6fc63219b51a3ad3ee35d58e70fb6a24c5c9" - 1 - 9 ; bindtextdomain - 22 ; G_ function - ) + ;;; Vendored files, and therefore shouldn't be tested @@ -123,4 +86,15 @@ ("module/sxml/html.scm" "b4ffca46c9c723f6828e32d8798f1bbc89c2bfcb6f1368906b2d4bdef11951db" 2) + + ("module/web/http.scm" + "50637403dd63d6d1390903cdea17abf26ad09bcf7f95b9492298da30ebcb03ff" + 2) + + ;; File is not tested at all, since it's mearly a "header" file. + ;; TODO possibly actually test extension loading, since it should + ;; fail gracefully when library is not available. + ("module/graphviz.scm" + "5ff20a55098973fcc8552cd897e779eaf01dc3d4909f8d23be47d317987d8e95" + 2) ) -- cgit v1.2.3