~ chicken-core (chicken-5) 479041d91e71cc242dc954090b943083d525e0d5

commit 479041d91e71cc242dc954090b943083d525e0d5
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Sat May 27 15:01:27 2017 +1200
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Sat May 27 15:33:46 2017 +1200

    Make `condition->list` use property lists for condition properties
    
    This makes `condition->list` use the same list-based representation of
    condition properties as the new `condition` procedure introduced in
    d6e89287. Where previously an association list-style representation was
    used (though it was not exactly an alist), we now use a property list.

diff --git a/library.scm b/library.scm
index 4007fe37..16c47833 100644
--- a/library.scm
+++ b/library.scm
@@ -4456,8 +4456,8 @@ EOF
 (import scheme)
 (import chicken.fixnum)
 (import chicken.foreign)
-(import (only chicken get-output-string open-output-string
-	      define-constant when fixnum? let-optionals make-parameter))
+(import (only chicken get-output-string open-output-string when unless
+	      define-constant fixnum? let-optionals make-parameter))
 
 ;;; Access backtrace:
 
@@ -4736,20 +4736,20 @@ EOF
 (define (condition? x) (##sys#structure? x 'condition))
 
 (define (condition->list x)
-  (or (condition? x)
-      (##sys#signal-hook
-       #:type-error 'condition->list
-       "argument is not a condition object" x))
-  (map
-   (lambda (k)
-     (cons k (let loop ((props (##sys#slot x 2))
-			(res '()))
-	       (cond ((null? props)
-		      res)
-		     ((eq? k (caar props))
-		      (loop (cddr props) (cons (list (cdar props) (cadr props)) res)))
-		     (else (loop (cddr props) res))))))
-   (##sys#slot x 1)))
+  (unless (condition? x)
+    (##sys#signal-hook
+     #:type-error 'condition->list
+     "argument is not a condition object" x))
+  (map (lambda (k)
+	 (cons k (let loop ((props (##sys#slot x 2)))
+		   (cond ((null? props) '())
+			 ((eq? (caar props) k)
+			  (cons (cdar props)
+				(cons (cadr props)
+				      (loop (cddr props)))))
+			 (else
+			  (loop (cddr props)))))))
+       (##sys#slot x 1)))
 
 (define (condition-predicate kind)
   (lambda (c) 
diff --git a/tests/condition-tests.scm b/tests/condition-tests.scm
index e74ba36c..5a9789b2 100644
--- a/tests/condition-tests.scm
+++ b/tests/condition-tests.scm
@@ -26,7 +26,8 @@
 ;testing condition conversion
 
 (assert (equal? (condition->list condition1)
-		'((exn (location test) (arguments ("bar")) (message "foo")))))
+		'((exn message "foo" arguments ("bar") location test))))
 
 (assert (equal? (condition->list condition3)
-		'((exn (location test) (arguments ("bar")) (message "foo")) (sam (partner "max") (age 23)))))
+		'((exn message "foo" arguments ("bar") location test)
+		  (sam age 23 partner "max"))))