~ chicken-core (chicken-5) /tests/record-rename-test.scm

 1;;;; record-rename-test.scm
 2
 3(define-record foo a)
 4
 5(define-record-type bar
 6  (make-bar x)
 7  bar?
 8  (x get-x))
 9
10(module m1 (make-foo make-bar foo? bar?)
11(import scheme (chicken base))
12
13(define-record foo a b)
14
15(define-record-type bar
16  (make-bar x y)
17  bar?
18  (x get-x) (y get-y))
19
20(let ((f1 (make-foo 1 2))
21      (f2 (make-bar 3 4)))
22  (print "Inside module m1: " (list foo f1 bar f2)))
23
24) ; m1
25
26(define toplevel-foo? foo?)
27(define toplevel-bar? foo?)
28
29(let ((f1 (make-foo 1))
30      (f2 (make-bar 2)))
31  (print "At toplevel before importing m1: " (list foo f1 bar f2))
32  (assert (foo? f1))
33  (assert (not (bar? f1)))
34  (assert (not (foo? f2)))
35  (assert (bar? f2)))
36
37(import m1)
38
39(let ((f1 (make-foo 1 2))
40      (f2 (make-bar 3 4)))
41  (print "At toplevel after importing m1: " (list foo f1 bar f2))
42  (assert (foo? f1))
43  (assert (not (bar? f1)))
44  (assert (not (foo? f2)))
45  (assert (bar? f2))
46  (assert (not (toplevel-foo? f1)))
47  (assert (not (toplevel-bar? f1)))
48  (assert (not (toplevel-foo? f2)))
49  (assert (not (toplevel-bar? f2))))