Merge pull request #945 from ekaitz-zarraga/concatenate!

Fix #944: concatenate! work with empty lists in any position 

2 files changed, 11 insertions, 6 deletions

diff --git a/lib/srfi/1/misc.scm b/lib/srfi/1/misc.scm
index ce360dc8..843ed19d 100644
--- a/lib/srfi/1/misc.scm
+++ b/lib/srfi/1/misc.scm
@@ -15,12 +15,13 @@
 (define (concatenate! lists)
   (if (null? lists)
       '()
-      (let lp ((ls lists))
-        (cond ((not (pair? (cdr ls)))
-               (car lists))
-              (else
-               (set-cdr! (last-pair (car ls)) (cadr ls))
-               (lp (cdr ls)))))))
+      (fold (lambda (el acc)
+                (cond
+                  ((null? acc) el)
+                  ((null? el) acc)
+                  (else (begin (set-cdr! (last-pair acc) el) acc))))
+              (car lists)
+              (cdr lists))))
 
 (define (append-reverse rev tail)
   (if (null? rev) tail (append-reverse (cdr rev) (cons (car rev) tail))))
diff --git a/lib/srfi/1/test.sld b/lib/srfi/1/test.sld
index b280b12b..94910f88 100644
--- a/lib/srfi/1/test.sld
+++ b/lib/srfi/1/test.sld
@@ -77,6 +77,10 @@
       (test 'a (append '() 'a))
       (test '(x y) (append '(x y)))
       (test '() (append))
+      (test (list 'a) (append! '() (list 'a)))
+      (test (list 'a 'b) (append! (list 'a) '() '() (list 'b)))
+      (test (list 'x 'y) (append! (list 'x 'y)))
+      (test '() (append!))
       (test '(c b a) (reverse '(a b c)))
       (test '((e (f)) d (b c) a) (reverse '(a (b c) d (e (f)))))
       (test '((one 1 odd) (two 2 even) (three 3 odd)) (zip '(one two three) '(1 2 3) '(odd even odd even odd even odd even)))