From: Taylor R Campbell <campbell@mumble.net>
Date: Sat, 23 Feb 2019 03:21:00 +0000 (+0000)
Subject: Fix recursion in n-ary append.
X-Git-Tag: mit-scheme-pucked-10.1.11~6^2~36
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=414b602168939c53317c364f6eb3d30fde5a7cca;p=mit-scheme.git

Fix recursion in n-ary append.
---

diff --git a/src/runtime/list.scm b/src/runtime/list.scm
index 384c5f133..8ba44ebcc 100644
--- 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))
-
+
 (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 22120405b..c03819561 100644
--- 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 ()