summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorIan Price <ianprice90@googlemail.com>2011-04-06 13:51:44 +0100
committerAndy Wingo <wingo@pobox.com>2011-04-11 18:00:36 +0200
commit15993bce1cd0a2e69f11a6ac1725fa7a219c5b7c (patch)
tree68b1243b4771c5e2b6615f467bfa92d0e3c241c0
parentcf9d4a82146556ff45d40d6eec8579082287900e (diff)
downloadguile-15993bce1cd0a2e69f11a6ac1725fa7a219c5b7c.tar.gz
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.
-rw-r--r--module/rnrs/base.scm2
-rw-r--r--test-suite/tests/r6rs-base.test8
2 files changed, 9 insertions, 1 deletions
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)))