source: project/release/5/defstruct/tags/2.0/tests/run.scm @ 35623

Last change on this file since 35623 was 35623, checked in by sjamaan, 17 months ago

Add CHICKEN 5 port of defstruct egg

File size: 2.6 KB
Line 
1(import defstruct test)
2
3(defstruct empty)
4(test-group "empty"
5 (test #t   (empty? (make-empty))))
6
7(defstruct simple field)
8(test-group "simple"
9 (test #t   (simple? (make-simple field: 'foo)))
10 (test 'foo (simple-field (make-simple field: 'foo))))
11
12(defstruct init (field-1 'one) (field-2 (list 'two)))
13(test-group "with initializer"
14 (test #t   (init? (make-init 'foo)))
15 (test 'foo (init-field-1 (make-init field-1: 'foo)))
16 ;; (list) should get evaluated twice
17 (test #t (not (eq? (init-field-2 (make-init))
18                    (init-field-2 (make-init))))))
19
20(defstruct complex field-1 (field-2 'two) field-3 (field-4 (list 'four)))
21(test-group "complex"
22 (test #t   (complex? (make-complex)))
23 (test 'foo (complex-field-1 (make-complex field-1: 'foo)))
24 (test #f   (complex-field-3 (make-complex field-1: 'foo)))
25 (test #f   (complex-field-1 (make-complex field-2: 'foo)))
26 (test 'two (complex-field-2 (make-complex field-1: 'foo)))
27 (test 'hai (complex-field-2 (make-complex field-2: 'hai field-1: 'foo))))
28
29(test-group "updaters"
30  (let* ((c1 (make-complex field-1: 'foo))
31         (c2 (update-complex c1 field-1: '()))
32         (c3 (update-complex c1 field-2: 'qux)))
33    (test 'foo (complex-field-1 c1))
34    (test 'two (complex-field-2 c1))
35    (test '() (complex-field-1 c2))
36    (test 'two (complex-field-2 c2))
37    (test 'foo (complex-field-1 c3))
38    ;; (list) initializer should not get re-evaluated on copy
39    (test #t (eq? (complex-field-4 c1)
40                  (complex-field-4 c2)))
41    (test #t (eq? (complex-field-4 c1)
42                  (complex-field-4 c3)))
43    (test #f (complex-field-3 c1))
44    (set-complex! c1 field-1: 'mutated)
45    (test 'mutated (complex-field-1 c1))
46    (test '() (complex-field-1 c2))))
47
48(test-group "hygiene"
49  (defstruct ini-capture (uninitialized 1))
50  (define i1 (make-ini-capture))
51  (test 1 (ini-capture-uninitialized (update-ini-capture i1)))
52  (test 2 (ini-capture-uninitialized (update-ini-capture i1 uninitialized: 2)))
53  (set-ini-capture! i1 uninitialized: 'uninitialized)
54  (test 'uninitialized (ini-capture-uninitialized i1)))
55
56(test-group "alist conversion"
57  (define rec1 (make-complex field-1: 1 field-2: 2 field-3: 3 field-4: 4))
58  (test '((field-1 . 1) (field-2 . 2) (field-3 . 3) (field-4 . 4))
59        (complex->alist rec1))
60  (define rec2 (alist->complex '((field-1 . 1) (field-2 . 2) (field-3 . 3) (field-4 . 4))))
61  (test 1 (complex-field-1 rec2))
62  (test 2 (complex-field-2 rec2))
63  (test 3 (complex-field-3 rec2))
64  (test 4 (complex-field-4 rec2))
65  (test-assert (complex? (alist->complex '())))
66  ;; Found by David Krentzlin
67  (test-assert (complex? (alist->complex '((nonexistant-field . 'hi))))))
68
69(test-exit)
Note: See TracBrowser for help on using the repository browser.