1 | ;-*- Mode: Lisp -*- |
---|
2 | ;;;; Author: Paul Dietz |
---|
3 | ;;;; Created: Mon May 19 20:07:40 2003 |
---|
4 | ;;;; Contains: More tests of structures |
---|
5 | |
---|
6 | (in-package :cl-test) |
---|
7 | |
---|
8 | ;;; I realized I had forgotten to test slot override in :include |
---|
9 | ;;; clauses in defstruct. |
---|
10 | |
---|
11 | (defstruct struct-include-01a |
---|
12 | a (b 0)) |
---|
13 | |
---|
14 | (defstruct (struct-include-01b (:include struct-include-01a |
---|
15 | (a 100) (b 'x))) |
---|
16 | (c 200) d) |
---|
17 | |
---|
18 | (deftest struct-include.1 |
---|
19 | (let ((obj (make-struct-include-01b))) |
---|
20 | (values |
---|
21 | (typep* obj 'struct-include-01a) |
---|
22 | (typep* obj 'struct-include-01b) |
---|
23 | (struct-include-01a-a obj) |
---|
24 | (struct-include-01a-b obj) |
---|
25 | (struct-include-01b-a obj) |
---|
26 | (struct-include-01b-b obj) |
---|
27 | (struct-include-01b-c obj))) |
---|
28 | t t 100 x 100 x 200) |
---|
29 | |
---|
30 | |
---|
31 | (deftest struct-include.2 |
---|
32 | (let ((obj (make-struct-include-01b :a 1 :b 2 :c 3 :d 4))) |
---|
33 | (values |
---|
34 | (typep* obj 'struct-include-01a) |
---|
35 | (typep* obj 'struct-include-01b) |
---|
36 | (struct-include-01a-a obj) |
---|
37 | (struct-include-01a-b obj) |
---|
38 | (struct-include-01b-a obj) |
---|
39 | (struct-include-01b-b obj) |
---|
40 | (struct-include-01b-c obj) |
---|
41 | (struct-include-01b-d obj) |
---|
42 | )) |
---|
43 | t t 1 2 1 2 3 4) |
---|
44 | |
---|
45 | (defstruct struct-include-02a |
---|
46 | (a 0 :type number)) |
---|
47 | |
---|
48 | (defstruct (struct-include-02b (:include struct-include-02a |
---|
49 | (a 10 :type integer)))) |
---|
50 | |
---|
51 | (deftest struct-include.3 |
---|
52 | (let ((obj (make-struct-include-02b))) |
---|
53 | (values |
---|
54 | (typep* obj 'struct-include-02a) |
---|
55 | (typep* obj 'struct-include-02b) |
---|
56 | (struct-include-02a-a obj) |
---|
57 | (struct-include-02b-a obj))) |
---|
58 | t t 10 10) |
---|
59 | |
---|
60 | (deftest struct-include.4 |
---|
61 | (let ((obj (make-struct-include-02a))) |
---|
62 | (values |
---|
63 | (typep* obj 'struct-include-02a) |
---|
64 | (typep* obj 'struct-include-02b) |
---|
65 | (struct-include-02a-a obj))) |
---|
66 | t nil 0) |
---|
67 | |
---|
68 | (deftest struct-include.5 |
---|
69 | (let ((obj (make-struct-include-02b :a 100))) |
---|
70 | (values |
---|
71 | (typep* obj 'struct-include-02a) |
---|
72 | (typep* obj 'struct-include-02b) |
---|
73 | (struct-include-02a-a obj) |
---|
74 | (struct-include-02b-a obj))) |
---|
75 | t t 100 100) |
---|
76 | |
---|
77 | (defstruct struct-include-03a |
---|
78 | (a 0 :type number)) |
---|
79 | |
---|
80 | (defstruct (struct-include-03b (:include struct-include-03a (a)))) |
---|
81 | |
---|
82 | (deftest struct-include.5a |
---|
83 | (let ((obj (make-struct-include-03b :a 100))) |
---|
84 | (values |
---|
85 | (typep* obj 'struct-include-03a) |
---|
86 | (typep* obj 'struct-include-03b) |
---|
87 | (struct-include-03a-a obj) |
---|
88 | (struct-include-03b-a obj))) |
---|
89 | t t 100 100) |
---|
90 | |
---|
91 | (defstruct struct-include-04a a b) |
---|
92 | |
---|
93 | (defstruct (struct-include-04b (:include struct-include-04a |
---|
94 | (a 0 :read-only t)))) |
---|
95 | |
---|
96 | (deftest struct-include.6 |
---|
97 | (let ((obj (make-struct-include-04b))) |
---|
98 | (values |
---|
99 | (typep* obj 'struct-include-04a) |
---|
100 | (typep* obj 'struct-include-04b) |
---|
101 | (struct-include-04a-a obj) |
---|
102 | (struct-include-04b-a obj))) |
---|
103 | t t 0 0) |
---|
104 | |
---|
105 | (deftest struct-include.7 |
---|
106 | (let ((obj (make-struct-include-04b :a 1 :b 2))) |
---|
107 | (values |
---|
108 | (typep* obj 'struct-include-04a) |
---|
109 | (typep* obj 'struct-include-04b) |
---|
110 | (struct-include-04a-a obj) |
---|
111 | (struct-include-04b-a obj) |
---|
112 | (struct-include-04a-b obj) |
---|
113 | (struct-include-04b-b obj))) |
---|
114 | t t 1 1 2 2) |
---|