~ chicken-core (chicken-5) /tests/condition-tests.scm

 1(import (chicken condition))
 2
 3(define condition1 (make-property-condition 'exn 'message "foo" 'arguments '("bar") 'location 'test))
 4(define condition2 (make-property-condition 'sam 'age 23 'partner "max"))
 5(define condition3 (make-composite-condition (make-property-condition 'exn 'message "foo" 'arguments '("bar") 'location 'test)(make-property-condition 'sam 'age 23 'partner "max")))
 6
 7(define conditions (list condition1 condition2 condition3))
 8
 9; testing type predicate
10(for-each (lambda (c) (assert (condition? c))) conditions)
11
12;testing slot allocations
13; slot 1 should be the kind key
14; slot 2 should hold all properties
15
16(assert (and (equal? '(exn) (##sys#slot condition1 1))
17	     (equal? '(sam) (##sys#slot condition2 1))
18	     (equal? '(exn sam) (##sys#slot condition3 1))))
19
20(assert (equal? (##sys#slot condition1 2)
21		'((exn . message) "foo" (exn . arguments) ("bar") (exn . location) test)))
22
23(assert (equal? (##sys#slot condition3 2)
24		'((exn . message) "foo" (exn . arguments) ("bar") (exn . location) test
25		  (sam . age) 23 (sam . partner) "max")))
26
27;testing condition conversion
28
29(assert (equal? (condition->list condition1)
30		'((exn message "foo" arguments ("bar") location test))))
31
32(assert (equal? (condition->list condition3)
33		'((exn message "foo" arguments ("bar") location test)
34		  (sam age 23 partner "max"))))
35
36;; testing errno in condition objects
37
38(import (chicken errno)
39        (chicken file)
40        (chicken process-context))
41
42(let ((nonexistent-path "this/path/does/not/exist/,hopefully"))
43  (assert (not (file-exists? nonexistent-path)))
44
45  (handle-exceptions exn
46    (assert (= (get-condition-property exn 'exn 'errno) errno/noent))
47    (delete-file nonexistent-path))
48
49  (handle-exceptions exn
50    (assert (= (get-condition-property exn 'exn 'errno) errno/noent))
51    (change-directory nonexistent-path)))