/[gcl]/gcl/ansi-tests/structures-01.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/structures-01.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by pfdietz, Thu Oct 17 13:16:56 2002 UTC revision 1.3 by pfdietz, Fri Jan 24 04:22:54 2003 UTC
# Line 21  Line 21 
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)

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26