aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2023-09-11 22:36:30 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2023-09-11 22:37:41 +0200
commitd026448edced5b71313629b9feaa9c38134e58e7 (patch)
treea81bb972c82d080d8028504e2c76992155eb2e40
parentAdd basic documentation of entry points. (diff)
downloadcalp-d026448edced5b71313629b9feaa9c38134e58e7.tar.gz
calp-d026448edced5b71313629b9feaa9c38134e58e7.tar.xz
Fix bug causing for's continue to not work.
-rw-r--r--module/hnh/util.scm4
-rw-r--r--module/scripts/find-undocumented.scm2
-rw-r--r--tests/test/util.scm8
3 files changed, 8 insertions, 6 deletions
diff --git a/module/hnh/util.scm b/module/hnh/util.scm
index ea7c0dd1..4bd06d11 100644
--- a/module/hnh/util.scm
+++ b/module/hnh/util.scm
@@ -142,7 +142,7 @@
(lambda (raw-continue)
(let ((continue
(case-lambda
- (() #f)
+ (() (raw-continue #f))
(args (apply raw-continue args)))))
b1 body ...)))])
<collection>))))
@@ -155,7 +155,7 @@
(call/ec (lambda (raw-continue)
(let ((continue
(case-lambda
- (() #f)
+ (() (raw-continue #f))
(args (apply raw-continue args)))))
b1 body ...))))
<collection>)))))))
diff --git a/module/scripts/find-undocumented.scm b/module/scripts/find-undocumented.scm
index 8c321fc2..499f18d6 100644
--- a/module/scripts/find-undocumented.scm
+++ b/module/scripts/find-undocumented.scm
@@ -130,8 +130,6 @@
(concatenate
(for path in (all-modules-under-directory source-directory)
(when (member path skip-files)
- (continue))
- (define components* (drop (path-split path) (length (path-split source-directory))))
(define name
(map string->symbol
(append (drop-right components* 1)
diff --git a/tests/test/util.scm b/tests/test/util.scm
index 41dbd7a3..bdd6e98e 100644
--- a/tests/test/util.scm
+++ b/tests/test/util.scm
@@ -71,8 +71,12 @@
'(x #f 2)
(for x in (iota 3)
(case x
- ((0) (continue 'x))
- ((1) (continue))
+ ((0)
+ (continue 'x)
+ (test-assert "Continue with value failed" #f))
+ ((1)
+ (continue)
+ (test-assert "Continue without value failed" #f))
(else x)))))
(test-equal "procedure label"