source: project/release/4/typed-records/tags/0.3/tests/t.scm @ 27291

Last change on this file since 27291 was 27291, checked in by felix winkelmann, 9 years ago

typed-records 0.3: appled fix for #899 (by megane)

File size: 1.1 KB
Line 
1;;;; t.scm - tests for typed-records.scm
2
3
4(use typed-records)
5
6
7(define-record point
8  x
9  (y : number))
10
11(define-record-type point3
12  (make-point3 y x)
13  point3?
14  (x get-x set-x : number)
15  (y get-y : number)
16  (foo get-foo)
17  (bar get-bar set-bar)
18  (baz get-baz : float)
19  (goo get-goo set-foo : pointer))
20
21(defstruct person
22  name
23  (age : fixnum)
24  ((species 'human) : symbol)
25  (planet 'earth))
26
27(define-syntax assert-type
28  (syntax-rules ()
29    ((_ t x)
30     #+compiling
31     (compiler-typecase x
32       (t 'ok)))))
33
34(let ((pt (make-point 1 2))
35      (p3 (make-point3 1 2)))
36
37  (assert-type number (point-y pt))
38  (assert-type float (get-baz p3))
39
40  (when (point? pt)
41    (assert-type (struct point) pt))
42
43  (assert-type (struct person) (make-person))
44
45  #+compiling
46  (set! person-age 42)
47
48  (let ((p (make-person age: 33)))
49    #+compiling 
50    (compiler-typecase (person-age p)
51      (fixnum 'ok))
52    (assert (= 33 (person-age p))))
53
54  )
55
56;;; test by megane (#899):
57
58(define-record-type foo
59  (make-foo bar)
60  foo?
61  (bar foo-bar foo-bar-set!))
62
63(display (make-foo 1))
64(newline)
Note: See TracBrowser for help on using the repository browser.