[Chicken-hackers] [PATCH] alist-update: don't segfault on non-list

[Florian Zumbiehl]

Check the alist passed to alist-update is actually a pair before
using ##sys#slot on it.
---
 data-structures.scm |   23 +++++++++++++----------
 1 files changed, 13 insertions(+), 10 deletions(-)

diff --git a/data-structures.scm b/data-structures.scm
index 419e1ad..1c504f6 100644
--- a/data-structures.scm
+++ b/data-structures.scm
@@ -229,16 +229,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]
-- 
1.7.2.5