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

[kzk at freedesktop.org]

Author: kzk
Date: 2005-09-30 22:59:19 -0700 (Fri, 30 Sep 2005)
New Revision: 1724

Modified:
   branches/r5rs/sigscheme/eval.c
   branches/r5rs/sigscheme/test/test-apply.scm
Log:
* sigscheme/eval.c
  - revert changes of r1723 because changing dot-arg desructively causes
    the problem like follows.

    - before first call
    (define (dotarg-2 x . y))

    - after first call
    (define (dotarg-2 x y))  <= argument list is changed destructively

* sigscheme/test/test-apply.scm
  - add test cases for this problem
      


Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c	2005-10-01 05:18:48 UTC (rev 1723)
+++ branches/r5rs/sigscheme/eval.c	2005-10-01 05:59:19 UTC (rev 1724)
@@ -122,7 +122,6 @@
 
         /* dot list appeared: fold the rest values into a variable */
         if (SYMBOLP(CDR(rest_vars))) {
-            SET_CDR(rest_vars, LIST_1(CDR(rest_vars)));
             SET_CDR(rest_vals, LIST_1(CDR(rest_vals)));
             break;
         }
@@ -209,8 +208,14 @@
          !NULLP(vars);
          vars = CDR(vars), vals = CDR(vals))
     {
-        if (EQ(CAR(vars), var))
-            return vals;
+        if (SYMBOLP(vars)) {
+            /* handle dot list */
+            return (EQ(vars, var)) ? vals : SCM_NULL;
+        } else {
+            /* normal binding */
+            if (EQ(CAR(vars), var))
+                return vals;
+        }
     }
 
     return SCM_NULL;

Modified: branches/r5rs/sigscheme/test/test-apply.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-apply.scm	2005-10-01 05:18:48 UTC (rev 1723)
+++ branches/r5rs/sigscheme/test/test-apply.scm	2005-10-01 05:59:19 UTC (rev 1724)
@@ -16,8 +16,15 @@
 (assert-equal? "apply check11" 2 (apply (lambda x x 2) '(1)))
 
 (assert-equal? "apply check12" '() (apply (lambda (a . b) b) '(1)))
+(assert-equal? "apply check13" '(2) (apply (lambda (a . b) b) '(1 2)))
 (assert-equal? "apply check13" '() (apply (lambda (a b . c) c) '(1 2)))
 
+(define (dotarg-2 x . y)
+  (+ x (car y)))
+
+(assert-equal? "sequence dot-arg func apply check" 4 (apply dotarg-2 '(1 3)))
+(assert-equal? "sequence dot-arg func apply check" 4 (apply dotarg-2 '(1 3)))
+
 (define compose
   (lambda (f g)
     (lambda args