[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Chicken-hackers] [PATCH] alist-update: don't segfault on non-list
From: |
Florian Zumbiehl |
Subject: |
[Chicken-hackers] [PATCH] alist-update: don't segfault on non-list |
Date: |
Thu, 14 Mar 2013 05:43:46 +0100 |
User-agent: |
Mutt/1.5.20 (2009-06-14) |
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
- [Chicken-hackers] [PATCH] alist-update: don't segfault on non-list,
Florian Zumbiehl <=