[uim-commit] r2535 - in branches/r5rs/sigscheme: . test

[yamaken at freedesktop.org]

Author: yamaken
Date: 2005-12-11 18:53:32 -0800 (Sun, 11 Dec 2005)
New Revision: 2535

Modified:
   branches/r5rs/sigscheme/operations-srfi2.c
   branches/r5rs/sigscheme/test/test-srfi2.scm
Log:
* sigscheme/operations-srfi2.c
  - (ScmExp_SRFI2_and_letstar): Fix (<symbol>) style claw handling
* sigscheme/test/test-srfi2.scm
  - Add test for (<symbol>) style claw handling


Modified: branches/r5rs/sigscheme/operations-srfi2.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi2.c	2005-12-12 02:45:32 UTC (rev 2534)
+++ branches/r5rs/sigscheme/operations-srfi2.c	2005-12-12 02:53:32 UTC (rev 2535)
@@ -89,16 +89,16 @@
         for (; !NULLP(claws); claws = CDR(claws)) {
             claw = CAR(claws);
             if (CONSP(claw)) {
-                if (SYMBOLP(CAR(claw))) {
+                if (NULLP(CDR(claw))) {
+                    /* (<expression>) */
+                    exp = CAR(claw);
+                    val = EVAL(exp, env);
+                } else if (SYMBOLP(CAR(claw))) {
                     /* (<variable> <expression>) */
                     if (!NULLP(SCM_SHIFT_RAW_2(var, exp, claw)))
                         goto err;
                     val = EVAL(exp, env);
                     env = Scm_ExtendEnvironment(LIST_1(var), LIST_1(val), env);
-                } else if (NULLP(CDR(claw))) {
-                    /* (<expression>) */
-                    exp = CAR(claw);
-                    val = EVAL(exp, env);
                 } else {
                     goto err;
                 }

Modified: branches/r5rs/sigscheme/test/test-srfi2.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-srfi2.scm	2005-12-12 02:45:32 UTC (rev 2534)
+++ branches/r5rs/sigscheme/test/test-srfi2.scm	2005-12-12 02:53:32 UTC (rev 2535)
@@ -94,27 +94,30 @@
                                         ((integer? 2))
                                         ((integer? #t)))
                                'ok))
+;; procedure itself as value
+(assert-true "and-let* #22" (and-let* ((even?))
+                               'ok))
 
 ;; combined form
-(assert-true  "and-let* #22" (and-let* (true
+(assert-true  "and-let* #23" (and-let* (true
                                         even?
                                         ((integer? 1)))
                                'ok))
-(assert-true  "and-let* #23" (and-let* (true
+(assert-true  "and-let* #24" (and-let* (true
                                         even?
                                         ((integer? 1))
                                         (foo '(1 2 3))
                                         ((list? foo))
                                         (bar foo))
                                'ok))
-(assert-false "and-let* #24" (and-let* (true
+(assert-false "and-let* #25" (and-let* (true
                                         even?
                                         ((integer? 1))
                                         (foo #(1 2 3))
                                         ((list? foo))
                                         (bar foo))
                                'ok))
-(assert-false "and-let* #25" (and-let* (true
+(assert-false "and-let* #26" (and-let* (true
                                         even?
                                         ((integer? 1))
                                         (foo '(1 2 3))