From d7d754b23c801fb5399cb3a93c307ac5f4a7e414 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 deletions(-) diff --git a/module/rnrs/base.scm b/module/rnrs/base.scm index 2f5a218..fb6716c 100644 --- a/module/rnrs/base.scm +++ b/module/rnrs/base.scm @@ -169,7 +169,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 1509b04..0a05b63 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)) (with-test-prefix "boolean=?" @@ -172,3 +174,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))) -- 1.7.3.4