~ chicken-core (chicken-5) 6edccb4bd5dfbedce6497cae8eae35b2279f8fa8

commit 6edccb4bd5dfbedce6497cae8eae35b2279f8fa8
Author:     Florian Zumbiehl <florz@florz.de>
AuthorDate: Thu Mar 14 05:43:46 2013 +0100
Commit:     Peter Bex <peter.bex@xs4all.nl>
CommitDate: Thu Jun 6 21:14:10 2013 +0200

    alist-update: don't segfault on non-list
    
    Check the alist passed to alist-update is actually a pair before
    using ##sys#slot on it.
    
    Signed-off-by: Peter Bex <peter.bex@xs4all.nl>

diff --git a/data-structures.scm b/data-structures.scm
index 54089249..1ac46e2b 100644
--- a/data-structures.scm
+++ b/data-structures.scm
@@ -218,16 +218,19 @@
 
 (define (alist-update k v lst #!optional (cmp eqv?))
   (let loop ((lst lst))
-    (if (null? lst)
-        (list (cons k v))
-        (let ((a (##sys#slot lst 0)))
-          (cond ((not (pair? a))
-                 (error 'alist-update "bad argument type" a))
-                ((cmp (##sys#slot a 0) k)
-                 (cons (cons k v) (##sys#slot lst 1)))
-                (else
-                 (cons (cons (##sys#slot a 0) (##sys#slot a 1))
-                       (loop (##sys#slot lst 1)))))))))
+    (cond ((null? lst)
+           (list (cons k v)))
+          ((not (pair? lst))
+           (error 'alist-update "bad argument type" lst))
+          (else
+           (let ((a (##sys#slot lst 0)))
+             (cond ((not (pair? a))
+                    (error 'alist-update "bad argument type" a))
+                   ((cmp (##sys#slot a 0) k)
+                    (cons (cons k v) (##sys#slot lst 1)))
+                   (else
+                    (cons (cons (##sys#slot a 0) (##sys#slot a 1))
+                          (loop (##sys#slot lst 1))))))))))
 
 (define (alist-ref x lst #!optional (cmp eqv?) (default #f))
   (let* ([aq (cond [(eq? eq? cmp) assq]