Fix recursion in n-ary append.

diff --git a/src/runtime/list.scm b/src/runtime/list.scm
index 384c5f13332b8209fea9a04e742209cc88987fd7..8ba44ebcc273b22a0263e5843ee8825a20dc6b00 100644 (file)
--- a/src/runtime/list.scm
+++ b/src/runtime/list.scm
@@ -561,14 +561,19 @@ USA.
   (make-arity-dispatched-procedure
    (named-lambda (append self . lists)
      self
-     (let recur ((lists lists))
-       (if (pair? lists)               ; Recursion limited by number of args.
-          (%append-2 (car lists) (recur (cdr lists)))
-          '())))
+     (if (pair? lists)
+        (let recur ((lists lists))
+          ;; Recursion limited by number of arguments.
+          (let ((list0 (car lists))
+                (lists (cdr lists)))
+            (if (pair? lists)
+                (%append-2 list0 (recur lists))
+                list0)))
+        '()))
    (lambda () '())
    (lambda (l) l)
    %append-2))
-
+\f
 (define (%append-2! l1 l2)
   (if (pair? l1)
       (begin (set-cdr! (last-pair l1) l2)
@@ -580,10 +585,15 @@ USA.
   (make-arity-dispatched-procedure
    (named-lambda (append! self . lists)
      self
-     (let recur ((lists lists))
-       (if (pair? lists)               ; Recursion limited by number of args.
-          (%append-2! (car lists) (recur (cdr lists)))
-          '())))
+     (if (pair? lists)
+        (let recur ((lists lists))
+          ;; Recursion limited by number of arguments.
+          (let ((list0 (car lists))
+                (lists (cdr lists)))
+            (if (pair? lists)
+                (%append-2! list0 (recur lists))
+                list0)))
+        '()))
    (lambda () '())
    (lambda (l) l)
    %append-2!))

diff --git a/tests/runtime/test-list.scm b/tests/runtime/test-list.scm
index 22120405b2da55705a00bfd92c8019e94ef81a2b..c0381956178b1f70a01ce5fc182bb7c43a6acc0c 100644 (file)
--- a/tests/runtime/test-list.scm
+++ b/tests/runtime/test-list.scm
@@ -40,17 +40,13 @@ USA.
   (lambda ()
     (assert-equal (append 'x) 'x)
     (assert-equal (append '(x) 'y) '(x . y))
-    (expect-error
-     (lambda ()
-       (assert-equal (append '(x) '(y) 'z) '(x y . z))))))
+    (assert-equal (append '(x) '(y) 'z) '(x y . z))))
 
 (define-test 'append!-dotted
   (lambda ()
     (assert-equal (append! 'x) 'x)
     (assert-equal (append! (list 'x) 'y) '(x . y))
-    (expect-error
-     (lambda ()
-       (assert-equal (append! (list 'x) (list 'y) 'z) '(x y . z))))))
+    (assert-equal (append! (list 'x) (list 'y) 'z) '(x y . z))))
 
 (define-test 'map-long
   (lambda ()