~ chicken-core (chicken-5) /tests/records-and-setters-test.scm

 1;;;; records-and-setters-test.scm
 2
 3
 4;;; define-record-type with setters
 5
 6(define-record-type foo 
 7  (make-foo x y z t)
 8  foo?
 9  (x get-x)
10  (y get-y set-y)
11  (z get-z (setter get-z))
12  (t get-t (setter make-foo)))
13
14(let ((f (make-foo 1 2 3 4)))
15  (assert (foo? f))
16  (assert (= 1 (get-x f)))
17  (assert (= 2 (get-y f)))
18  (set-y f 99)
19  (assert (= 99 (get-y f)))
20  (set! (get-z f) 100)
21  (assert (= 100 (get-z f)))
22  (set! (make-foo f) 1000)
23  (assert (= 1000 (get-t f))))
24
25(define-record bar
26  a
27  (setter b))
28
29(let ((b (make-bar 1 2)))
30  (assert (bar? b))
31  (bar-a-set! b 3)
32  (assert (= 3 (bar-a b)))
33  (setter bar-b)
34  (set! (bar-b b) 4)
35  (assert (= (bar-b b) 4)))