summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2007-07-18 20:25:38 +0000
committerLudovic Courtès <ludo@gnu.org>2007-07-18 20:25:38 +0000
commit9ee0f67880df329b2e330a96fe2c8e37410ef48c (patch)
tree9b7483bba1e8db3e06eab63e1d27e96e92bb59b8
parentdf4497227344b13df10e2a4f7ae8811a5fbaca17 (diff)
downloadguile-9ee0f67880df329b2e330a96fe2c8e37410ef48c.tar.gz
Changes from arch/CVS synchronization
-rw-r--r--test-suite/ChangeLog4
-rw-r--r--test-suite/tests/syntax.test44
2 files changed, 48 insertions, 0 deletions
diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog
index 54232b6a2..d4eaf432b 100644
--- a/test-suite/ChangeLog
+++ b/test-suite/ChangeLog
@@ -1,3 +1,7 @@
+2007-07-18 Stephen Compall <s11@member.fsf.org>
+
+ * tests/syntax.test: Add SRFI-61 `cond' tests.
+
2007-07-11 Ludovic Courtès <ludo@gnu.org>
* tests/goops.test (defining methods): New test prefix.
diff --git a/test-suite/tests/syntax.test b/test-suite/tests/syntax.test
index cda9469a3..1277e5204 100644
--- a/test-suite/tests/syntax.test
+++ b/test-suite/tests/syntax.test
@@ -557,6 +557,50 @@
(let ((=> 'foo))
(eq? (cond (else => identity)) identity)))))
+ (with-test-prefix "SRFI-61"
+
+ (pass-if "always available"
+ (cond-expand (srfi-61 #t) (else #f)))
+
+ (pass-if "single value consequent"
+ (eq? 'ok (cond (#t identity => (lambda (x) 'ok)) (else #f))))
+
+ (pass-if "single value alternate"
+ (eq? 'ok (cond (#t not => (lambda (x) #f)) (else 'ok))))
+
+ (pass-if-exception "doesn't affect standard =>"
+ exception:wrong-num-args
+ (cond ((values 1 2) => (lambda (x y) #t))))
+
+ (pass-if "multiple values consequent"
+ (equal? '(2 1) (cond ((values 1 2)
+ (lambda (one two)
+ (and (= 1 one) (= 2 two))) =>
+ (lambda (one two) (list two one)))
+ (else #f))))
+
+ (pass-if "multiple values alternate"
+ (eq? 'ok (cond ((values 2 3 4)
+ (lambda args (equal? '(1 2 3) args)) =>
+ (lambda (x y z) #f))
+ (else 'ok))))
+
+ (pass-if "zero values"
+ (eq? 'ok (cond ((values) (lambda () #t) => (lambda () 'ok))
+ (else #f))))
+
+ (pass-if "bound => is handled correctly"
+ (let ((=> 'ok))
+ (eq? 'ok (cond (#t identity =>) (else #f)))))
+
+ (pass-if-exception "missing recipient"
+ '(syntax-error . "Missing recipient")
+ (cond (#t identity =>)))
+
+ (pass-if-exception "extra recipient"
+ '(syntax-error . "Extra expression")
+ (cond (#t identity => identity identity))))
+
(with-test-prefix "unmemoization"
(pass-if "normal clauses"