diff options
author | Ian Price <ianprice90@googlemail.com> | 2011-04-06 13:51:44 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-04-11 18:00:36 +0200 |
commit | 15993bce1cd0a2e69f11a6ac1725fa7a219c5b7c (patch) | |
tree | 68b1243b4771c5e2b6615f467bfa92d0e3c241c0 | |
parent | cf9d4a82146556ff45d40d6eec8579082287900e (diff) | |
download | guile-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.scm | 2 | ||||
-rw-r--r-- | test-suite/tests/r6rs-base.test | 8 |
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))) |