21 |
;; Test that make-s-1 produces objects |
;; Test that make-s-1 produces objects |
22 |
;; of the correct type |
;; of the correct type |
23 |
(deftest structure-1-1 |
(deftest structure-1-1 |
24 |
(not (not (typep (make-s-1) 's-1))) |
(notnot-mv (typep (make-s-1) 's-1)) |
25 |
t) |
t) |
26 |
|
|
27 |
;; Test that the -p predicate exists |
;; Test that the -p predicate exists |
28 |
(deftest structure-1-2 |
(deftest structure-1-2 |
29 |
(not (not (s-1-p (make-s-1)))) |
(notnot-mv (s-1-p (make-s-1))) |
30 |
t) |
t) |
31 |
|
|
32 |
;; Test that all the objects in the universe are |
;; Test that all the objects in the universe are |
33 |
;; not of this type |
;; not of this type |
34 |
(deftest structure-1-3 |
(deftest structure-1-3 |
35 |
(count-if #'s-1-p *universe*) |
(count-if #'s-1-p *universe*) |
36 |
0) |
0) |
37 |
|
|
38 |
(deftest structure-1-4 |
(deftest structure-1-4 |
39 |
(count-if #'(lambda (x) (typep x 's-1)) *universe*) |
(count-if #'(lambda (x) (typep x 's-1)) *universe*) |
40 |
0) |
0) |
41 |
|
|
42 |
;; Check that the fields can be read after being initialized |
;; Check that the fields can be read after being initialized |
43 |
(deftest structure-1-5 |
(deftest structure-1-5 |
44 |
(s-1-foo (make-s-1 :foo 'a)) |
(s-1-foo (make-s-1 :foo 'a)) |
45 |
a) |
a) |
46 |
|
|
47 |
(deftest structure-1-6 |
(deftest structure-1-6 |
48 |
(s-1-bar (make-s-1 :bar 'b)) |
(s-1-bar (make-s-1 :bar 'b)) |
49 |
b) |
b) |
50 |
|
|
51 |
(deftest structure-1-7 |
(deftest structure-1-7 |
52 |
(let ((s (make-s-1 :foo 'c :bar 'd))) |
(let ((s (make-s-1 :foo 'c :bar 'd))) |
53 |
(list (s-1-foo s) (s-1-bar s))) |
(list (s-1-foo s) (s-1-bar s))) |
54 |
(c d)) |
(c d)) |
55 |
|
|
56 |
;; Can setf the fields |
;; Can setf the fields |
57 |
(deftest structure-1-8 |
(deftest structure-1-8 |
58 |
(let ((s (make-s-1))) |
(let ((s (make-s-1))) |
59 |
(setf (s-1-foo s) 'e) |
(setf (s-1-foo s) 'e) |
60 |
(setf (s-1-bar s) 'f) |
(setf (s-1-bar s) 'f) |
61 |
(list (s-1-foo s) (s-1-bar s))) |
(list (s-1-foo s) (s-1-bar s))) |
62 |
(e f)) |
(e f)) |
63 |
|
|
64 |
(deftest structure-1-9 |
(deftest structure-1-9 |
65 |
(let ((s (make-s-1 :foo 'a :bar 'b))) |
(let ((s (make-s-1 :foo 'a :bar 'b))) |
66 |
(setf (s-1-foo s) 'e) |
(setf (s-1-foo s) 'e) |
67 |
(setf (s-1-bar s) 'f) |
(setf (s-1-bar s) 'f) |
68 |
(list (s-1-foo s) (s-1-bar s))) |
(list (s-1-foo s) (s-1-bar s))) |
69 |
(e f)) |
(e f)) |
70 |
|
|
71 |
;; copier function defined |
;; copier function defined |
72 |
(deftest structure-1-10 |
(deftest structure-1-10 |
73 |
(let ((s (make-s-1 :foo 'a :bar 'b))) |
(let ((s (make-s-1 :foo 'a :bar 'b))) |
74 |
(let ((s2 (copy-s-1 s))) |
(let ((s2 (copy-s-1 s))) |
75 |
(setf (s-1-foo s) nil) |
(setf (s-1-foo s) nil) |
76 |
(setf (s-1-bar s) nil) |
(setf (s-1-bar s) nil) |
77 |
(list (s-1-foo s2) |
(list (s-1-foo s2) |
78 |
(s-1-bar s2)))) |
(s-1-bar s2)))) |
79 |
(a b)) |
(a b)) |
80 |
|
|
81 |
;; Make produces unique items |
;; Make produces unique items |
82 |
(deftest structure-1-11 |
(deftest structure-1-11 |
83 |
(eqt (make-s-1) (make-s-1)) |
(eqt (make-s-1) (make-s-1)) |
84 |
nil) |
nil) |
85 |
|
|
86 |
(deftest structure-1-12 |
(deftest structure-1-12 |
87 |
(eqt (make-s-1 :foo 'a :bar 'b) |
(eqt (make-s-1 :foo 'a :bar 'b) |
88 |
(make-s-1 :foo 'a :bar 'b)) |
(make-s-1 :foo 'a :bar 'b)) |
89 |
nil) |
nil) |
90 |
|
|
91 |
;; More type and class checks |
;; More type and class checks |
92 |
|
|
93 |
(deftest structure-1-13 |
(deftest structure-1-13 |
94 |
(not (not (typep (class-of (make-s-1)) 'structure-class))) |
(notnot-mv (typep (class-of (make-s-1)) 'structure-class)) |
95 |
t) |
t) |
96 |
|
|
97 |
(deftest structure-1-14 |
(deftest structure-1-14 |
98 |
(not (not (typep (make-s-1) 'structure-object))) |
(notnot-mv (typep (make-s-1) 'structure-object)) |
99 |
t) |
t) |
100 |
|
|
101 |
(deftest structure-1-15 |
(deftest structure-1-15 |
102 |
(subtypep* 's-1 'structure-object) |
(subtypep* 's-1 'structure-object) |
103 |
t t) |
t t) |