mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00
Code Activity

fix assert to return true value.

Browse source 
* module/rnrs/base.scm (assert): returns value instead of void.

* test-suite/tests/r6rs-base.test ("assert"): add test cases.
This commit is contained in:
Ian Price 2011-04-06 13:51:44 +01:00 • committed by Andy Wingo
parent cf9d4a8214
commit 15993bce1c
2 changed files with 9 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

2
module/rnrs/base.scm
View file

@ -175,7 +175,7 @@
(define-syntax assert (define-syntax assert
(syntax-rules () (syntax-rules ()
((_ expression) ((_ expression)
(if (not expression) (or expression
(raise (condition (raise (condition
(make-assertion-violation) (make-assertion-violation)
(make-message-condition (make-message-condition

8
test-suite/tests/r6rs-base.test
View file

@ -19,6 +19,8 @@
(define-module (test-suite test-r6rs-base) (define-module (test-suite test-r6rs-base)
:use-module ((rnrs base) :version (6)) :use-module ((rnrs base) :version (6))
:use-module ((rnrs conditions) :version (6))
:use-module ((rnrs exceptions) :version (6))
:use-module (test-suite lib)) :use-module (test-suite lib))
@ -188,3 +190,9 @@
(pass-if (not (integer-valued? +0.01i))) (pass-if (not (integer-valued? +0.01i)))
(pass-if (not (integer-valued? -inf.0i)))) (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)))