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)))