From 15993bce1cd0a2e69f11a6ac1725fa7a219c5b7c Mon Sep 17 00:00:00 2001 From: Ian Price Date: Wed, 6 Apr 2011 13:51:44 +0100 Subject: [PATCH] fix assert to return true value. * module/rnrs/base.scm (assert): returns value instead of void. * test-suite/tests/r6rs-base.test ("assert"): add test cases. --- module/rnrs/base.scm | 2 +- test-suite/tests/r6rs-base.test | 8 ++++++++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/module/rnrs/base.scm b/module/rnrs/base.scm index b867929fe..4cfd1d1cc 100644 --- a/module/rnrs/base.scm +++ b/module/rnrs/base.scm @@ -175,7 +175,7 @@ (define-syntax assert (syntax-rules () ((_ expression) - (if (not expression) + (or expression (raise (condition (make-assertion-violation) (make-message-condition diff --git a/test-suite/tests/r6rs-base.test b/test-suite/tests/r6rs-base.test index dfddf7c34..df11d67b3 100644 --- a/test-suite/tests/r6rs-base.test +++ b/test-suite/tests/r6rs-base.test @@ -19,6 +19,8 @@ (define-module (test-suite test-r6rs-base) :use-module ((rnrs base) :version (6)) + :use-module ((rnrs conditions) :version (6)) + :use-module ((rnrs exceptions) :version (6)) :use-module (test-suite lib)) @@ -188,3 +190,9 @@ (pass-if (not (integer-valued? +0.01i))) (pass-if (not (integer-valued? -inf.0i)))) +(with-test-prefix "assert" + (pass-if "assert returns value" (= 1 (assert 1))) + (pass-if "assertion-violation" + (guard (condition ((assertion-violation? condition) #t)) + (assert #f) + #f)))