Get arguments of error conditions for Chicken.

assert-chicken.scm

@@ -6,11 +6,15 @@
 (include "assert-r5rs.scm")
 
 (define (-error->string ex)
-    (cond ((symbol? ex)    (symbol->string ex))
-          ((string? ex)    ex)
+    (cond ((null? ex)                     "")
+          ((string? ex)                   ex)
+          ((symbol? ex)                   (symbol->string ex))
+          ((list? ex)                     (string-append " (" (apply string-append (map -error->string ex)) ")"))
           ;; SRFI-12/Chicken specific code
-          ((condition? ex) (-error->string ((condition-property-accessor 'exn 'message) ex)))
-          (else            "<unknown exception type>")))
+          ((condition? ex)                (string-append (-error->string ((condition-property-accessor 'exn 'message) ex))
+                                                         (-error->string ((condition-property-accessor 'exn 'arguments) ex))))
+          (else                           (pp ex)
+                                          "<unknown exception type>")))
 
 (define (-run-with-exception-handler handler body)
     ;; SRFI-12 specific code

assert-test-chicken.scm

@@ -123,13 +123,13 @@
     "expected:<not null> but was:<null>"
     (assert-not-null '()))
 
-(test-case "(assert-raise) on raise symbol"
-    (assert-raise "unbound variable" (lambda ()
-                         (raise 'a))))
+(test-case "(assert-raise) on abort symbol"
+    (assert-raise "a" (lambda ()
+                         (abort 'a))))
 
-(test-case "(assert-raise) on raise string"
-    (assert-raise "unbound variable" (lambda ()
-                          (raise "a"))))
+(test-case "(assert-raise) on abort string"
+    (assert-raise "a" (lambda ()
+                          (abort "a"))))
 
 (test-case "(assert-raise) on error symbol"
     (assert-raise 'a (lambda ()
@@ -140,21 +140,21 @@
                         (error "a"))))
 
 (test-failure "(assert-raise) fails"
-    "raise expected:<a> but was:<unbound variable>"
+    "raise expected:<a> but was:<b>"
     (assert-raise 'a (lambda ()
-                        (raise 'b))))
+                        (abort 'b))))
 
 (test-failure "(assert-raise) fails when no raise"
     "raise expected:<a> but was:<no raise in body>"
     (assert-raise 'a (lambda ()
                         (+ 1 1))))
 
 (test-case "(assert-raise) on unbound global variable"
-    (assert-raise "unbound variable" (lambda ()
+    (assert-raise "unbound variable (unbound-global-variable)" (lambda ()
                         (unbound-global-variable))))
 
 (test-case "(assert-raise) on type error"
-    (assert-raise "bad argument type" (lambda ()
+    (assert-raise "bad argument type (1)" (lambda ()
                                         (+ 1 "1"))))
 
 (test-case "(assert-all) allows several assertions"