From e4b86a580790ace1c03bd13daa5adc63f4e2b728 Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Sat, 15 Dec 2012 13:06:32 +0900
Subject: [PATCH] Updating SRFI-2 to support single variable references as
 clauses, and adding tests. Also allowing empty bodies.  (I think both are
 terrible extensions.)

---
 lib/srfi/2.sld         | 10 +++++++++-
 tests/srfi-2-tests.scm | 43 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 52 insertions(+), 1 deletion(-)
 create mode 100644 tests/srfi-2-tests.scm

diff --git a/lib/srfi/2.sld b/lib/srfi/2.sld
index 5b4a2366..d046f99b 100644
--- a/lib/srfi/2.sld
+++ b/lib/srfi/2.sld
@@ -6,10 +6,18 @@
    (define-syntax and-let*
      (syntax-rules ()
        ((and-let* () . body)
-        (begin . body))
+        (begin #t . body))
+       ((and-let* ((var expr)))
+        expr)
+       ((and-let* ((expr)))
+        expr)
+       ((and-let* (expr))  ; Extension: in SRFI-2 this can only be a var ref
+        expr)
        ((and-let* ((var expr) . rest) . body)
         (let ((var expr))
           (and var (and-let* rest . body))))
        ((and-let* ((expr) . rest) . body)
+        (and expr (and-let* rest . body)))
+       ((and-let* (expr . rest) . body)   ; Same extension as above
         (let ((tmp expr))
           (and tmp (and-let* rest . body))))))))
diff --git a/tests/srfi-2-tests.scm b/tests/srfi-2-tests.scm
new file mode 100644
index 00000000..02579344
--- /dev/null
+++ b/tests/srfi-2-tests.scm
@@ -0,0 +1,43 @@
+
+(import (scheme base) (srfi 2) (chibi test))
+
+(test-begin "srfi-2")
+
+(test 1 (and-let* () 1))
+(test 2 (and-let* () 1 2))
+(test #t (and-let* () ))
+
+(test #f (let ((x #f)) (and-let* (x))))
+(test 1 (let ((x 1)) (and-let* (x))))
+(test #f (and-let* ((x #f)) ))
+(test 1 (and-let* ((x 1)) ))
+;; (test-syntax-error (and-let* ( #f (x 1))))
+(test #f (and-let* ( (#f) (x 1)) ))
+;; (test-syntax-error (and-let* (2 (x 1))))
+(test 1 (and-let* ( (2) (x 1)) ))
+(test 2 (and-let* ( (x 1) (2)) ))
+(test #f (let ((x #f)) (and-let* (x) x)))
+(test "" (let ((x "")) (and-let* (x) x)))
+(test "" (let ((x "")) (and-let* (x)  )))
+(test 2 (let ((x 1)) (and-let* (x) (+ x 1))))
+(test #f (let ((x #f)) (and-let* (x) (+ x 1))))
+(test 2 (let ((x 1)) (and-let* (((positive? x))) (+ x 1))))
+(test #t (let ((x 1)) (and-let* (((positive? x))) )))
+(test #f (let ((x 0)) (and-let* (((positive? x))) (+ x 1))))
+(test 3  (let ((x 1)) (and-let* (((positive? x)) (x (+ x 1))) (+ x 1))))
+(test 4
+    (let ((x 1))
+      (and-let* (((positive? x)) (x (+ x 1)) (x (+ x 1))) (+ x 1))))
+
+(test 2 (let ((x 1)) (and-let* (x ((positive? x))) (+ x 1))))
+(test 2 (let ((x 1)) (and-let* ( ((begin x)) ((positive? x))) (+ x 1))))
+(test #f (let ((x 0)) (and-let* (x ((positive? x))) (+ x 1))))
+(test #f (let ((x #f)) (and-let* (x ((positive? x))) (+ x 1))))
+(test #f (let ((x #f)) (and-let* ( ((begin x)) ((positive? x))) (+ x 1))))
+
+(test  #f (let ((x 1)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))))
+(test  #f (let ((x 0)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))))
+(test  #f (let ((x #f)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))))
+(test  3/2 (let ((x 3)) (and-let* (x (y (- x 1)) ((positive? y))) (/ x y))))
+
+(test-end)