~ chicken-core (chicken-5) 4fb8be6f5e7d5c749b6b4260e42008ade9e36ed4
commit 4fb8be6f5e7d5c749b6b4260e42008ade9e36ed4
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Fri Nov 15 15:17:26 2013 +1300
Commit: Peter Bex <peter.bex@xs4all.nl>
CommitDate: Fri Nov 15 20:23:31 2013 +0100
Return the result of EXP from (assert EXP)
Signed-off-by: Peter Bex <peter.bex@xs4all.nl>
diff --git a/chicken-syntax.scm b/chicken-syntax.scm
index 29ed89d2..112a0782 100644
--- a/chicken-syntax.scm
+++ b/chicken-syntax.scm
@@ -171,17 +171,19 @@
(##sys#check-syntax 'assert form '#(_ 1))
(let* ((exp (cadr form))
(msg-and-args (cddr form))
- (msg (optional msg-and-args "assertion failed")))
+ (msg (optional msg-and-args "assertion failed"))
+ (tmp (r 'tmp)))
(when (string? msg)
(and-let* ((ln (get-line-number form)))
(set! msg (string-append "(" ln ") " msg))))
- `(##core#if (##core#check ,exp)
- (##core#undefined)
- (##sys#error
- ,msg
- ,@(if (pair? msg-and-args)
- (cdr msg-and-args)
- `((##core#quote ,(##sys#strip-syntax exp)))))))))))
+ `(##core#let ((,tmp ,exp))
+ (##core#if (##core#check ,tmp)
+ ,tmp
+ (##sys#error
+ ,msg
+ ,@(if (pair? msg-and-args)
+ (cdr msg-and-args)
+ `((##core#quote ,(##sys#strip-syntax exp))))))))))))
(##sys#extend-macro-environment
'ensure
diff --git a/tests/scrutiny-2.expected b/tests/scrutiny-2.expected
index 1985dac1..10cd844e 100644
--- a/tests/scrutiny-2.expected
+++ b/tests/scrutiny-2.expected
@@ -43,6 +43,10 @@ Note: at toplevel:
(scrutiny-tests-2.scm:22) in procedure call to `null?', the predicate is called with an argument of type
`null' and will always return true
+Note: at toplevel:
+ (scrutiny-tests-2.scm:22) in procedure call to `null?', the predicate is called with an argument of type
+ `pair' and will always return false
+
Note: at toplevel:
(scrutiny-tests-2.scm:22) in procedure call to `null?', the predicate is called with an argument of type
`fixnum' and will always return false
Trap