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.

diff --git a/module/rnrs/base.scm b/module/rnrs/base.scm
index b867929fe59ffb1a9dba530c4d087908493e3281..4cfd1d1cc957d79f35a824d7bf06948acb16ead6 100644 (file)
--- 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 dfddf7c34b593b34d4e45482429db9e391c14b60..df11d67b3305e5cf634f3cc3628728c8db1eb062 100644 (file)
--- 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)))