source: project/release/4/defstruct/trunk/tests/run.scm @ 11581

Last change on this file since 11581 was 11581, checked in by sjamaan, 12 years ago

Add improved port to hygienic-chicken of defstruct

File size: 1.7 KB
Line 
1(load "../defstruct.scm")
2
3(import defstruct)
4
5(require-extension test)
6
7(defstruct empty)
8(test-group "empty"
9 (test #t   (empty? (make-empty))))
10
11(defstruct simple field)
12(test-group "simple"
13 (test #t   (simple? (make-simple field: 'foo)))
14 (test 'foo (simple-field (make-simple field: 'foo))))
15
16(defstruct init (field-1 'one) (field-2 (list 'two)))
17(test-group "with initializer"
18 (test #t   (init? (make-init 'foo)))
19 (test 'foo (init-field-1 (make-init field-1: 'foo)))
20 ;; (list) should get evaluated twice
21 (test #t (not (eq? (init-field-2 (make-init))
22                    (init-field-2 (make-init))))))
23
24(defstruct complex field-1 (field-2 'two) field-3 (field-4 (list 'four)))
25(test-group "complex"
26 (test #t   (complex? (make-complex)))
27 (test 'foo (complex-field-1 (make-complex field-1: 'foo)))
28 (test #f   (complex-field-3 (make-complex field-1: 'foo)))
29 (test #f   (complex-field-1 (make-complex field-2: 'foo)))
30 (test 'two (complex-field-2 (make-complex field-1: 'foo)))
31 (test 'hai (complex-field-2 (make-complex field-2: 'hai field-1: 'foo))))
32
33(test-group "updaters"
34  (let* ((c1 (make-complex field-1: 'foo))
35         (c2 (copy-complex c1 field-1: 'bar))
36         (c3 (copy-complex c1 field-2: 'qux)))
37    (test 'foo (complex-field-1 c1))
38    (test 'two (complex-field-2 c1))
39    (test 'bar (complex-field-1 c2))
40    (test 'two (complex-field-2 c2))
41    (test 'foo (complex-field-1 c3))
42    ;; (list) initializer should not get re-evaluated on copy
43    (test #t (eq? (complex-field-4 c1)
44                  (complex-field-4 c2)))
45    (test #t (eq? (complex-field-4 c1)
46                  (complex-field-4 c3)))
47    (test #f   (complex-field-3 c1))
48    (set-complex! c1 field-1: 'mutated)
49    (test 'mutated (complex-field-1 c1))
50    (test 'bar (complex-field-1 c2))))
Note: See TracBrowser for help on using the repository browser.