From 9ee0f67880df329b2e330a96fe2c8e37410ef48c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 18 Jul 2007 20:25:38 +0000
Subject: [PATCH] Changes from arch/CVS synchronization

---
 test-suite/ChangeLog         |  4 ++++
 test-suite/tests/syntax.test | 44 ++++++++++++++++++++++++++++++++++++
 2 files changed, 48 insertions(+)

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"