aboutsummaryrefslogtreecommitdiff
path: root/scripts
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2022-03-06 11:53:40 +0100
committerHugo Hörnquist <hugo@lysator.liu.se>2022-03-07 20:11:00 +0100
commit571eb0764fe001bc9bae7a18eeaae5d6e7dcdab0 (patch)
treed9e78d6b4e44105fd3717404c41260c2f8749f43 /scripts
parentRepair begin1 tests. (diff)
downloadcalp-571eb0764fe001bc9bae7a18eeaae5d6e7dcdab0.tar.gz
calp-571eb0764fe001bc9bae7a18eeaae5d6e7dcdab0.tar.xz
Test runner only output coverage of "our" modules.
Diffstat (limited to 'scripts')
-rw-r--r--scripts/all-modules.scm33
-rwxr-xr-xscripts/use2dot/gen-use.scm32
2 files changed, 37 insertions, 28 deletions
diff --git a/scripts/all-modules.scm b/scripts/all-modules.scm
new file mode 100644
index 00000000..41f35393
--- /dev/null
+++ b/scripts/all-modules.scm
@@ -0,0 +1,33 @@
+(define-module (all-modules)
+ :use-module (ice-9 regex)
+ :use-module (srfi srfi-1)
+ :use-module (ice-9 ftw)
+ :use-module (ice-9 match)
+ :export (all-modules-under-directory))
+
+(define (all-modules-under-directory dir)
+ "Returns two values, all scm files in dir, and all top
+level modules in those files"
+
+ (define re (make-regexp "\\.scm$"))
+
+ (define files '())
+
+ (ftw dir (lambda (filename statinfo flag)
+ (cond ((and (eq? flag 'regular)
+ (regexp-exec re filename))
+ => (lambda (m)
+ (set! files (cons filename files))
+ #t
+ ))
+ (else #t))))
+
+
+ (values files
+ (filter identity
+ (map (lambda (file)
+ (match (call-with-input-file file read)
+ (('define-module (module ...) _ ...)
+ module)
+ (_ #f)))
+ files))))
diff --git a/scripts/use2dot/gen-use.scm b/scripts/use2dot/gen-use.scm
index e02be9bd..6c621fdd 100755
--- a/scripts/use2dot/gen-use.scm
+++ b/scripts/use2dot/gen-use.scm
@@ -2,43 +2,19 @@
!#
(add-to-load-path (dirname (current-filename)))
+(add-to-load-path (dirname (dirname (current-filename))))
(use-modules ((scripts frisk) :select (make-frisker edge-type edge-up
edge-down))
(srfi srfi-1)
- (ice-9 ftw)
- (ice-9 regex)
- (ice-9 match)
((graphviz) :prefix gv.)
+ (all-modules)
)
(define scan (make-frisker `(default-module . (calp main))))
-(define re (make-regexp "\\.scm$"))
-
-(define lst '())
-
-(ftw "module" (lambda (filename statinfo flag)
- (cond ((and (eq? flag 'regular)
- (regexp-exec re filename))
- => (lambda (m)
- (set! lst (cons filename lst))
- #t
- ))
- (else #t))))
-
-
-
-(define files lst)
-
-(define our-modules
- (filter identity
- (map (lambda (file)
- (match (call-with-input-file file read)
- (('define-module (module ...) _ ...)
- module)
- (_ #f)))
- files)))
+(define-values (files our-modules)
+ (all-modules-under-directory "module"))
(define graph (gv.digraph "G"))
(gv.setv graph "color" "blue")