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

Diff of /gcl/ansi-tests/structures-02.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, Tue Dec 10 05:00:16 2002 UTC
# Line 23  Line 23 
23    
24  ;; Fields have appropriate values  ;; Fields have appropriate values
25  (deftest structure-2-1  (deftest structure-2-1
26    (let ((s (make-s-2)))    (let ((*s-2-f6-counter* 0))
27      (not (not      (let ((s (make-s-2)))
28            (and        (and
29             (eql (s-2-f1 s) 0)         (eqlt (s-2-f1 s) 0)
30             (eqt (s-2-f2 s) 'a)         (eqt  (s-2-f2 s) 'a)
31             (eql (s-2-f3 s) 1.21)         (= (s-2-f3 s) 1.21)
32             (eql (s-2-f4 s) #\d)         (eqlt (s-2-f4 s) #\d)
33             (equal (s-2-f5 s) '(a b))         (equalt (s-2-f5 s) '(a b))
34             (eql (s-2-f6 s) *s-2-f6-counter*)))))         (eqlt (s-2-f6 s) *s-2-f6-counter*)
35           (eqlt *s-2-f6-counter* 1))))
36    t)    t)
37    
38  ;; Two successive invocations of make-s-2 return different objects  ;; Two successive invocations of make-s-2 return different objects
39  (deftest structure-2-2  (deftest structure-2-2
40    (eqt (s-2-f5 (make-s-2))    (let ((*s-2-f6-counter* 0))
41         (s-2-f5 (make-s-2)))      (eqt (s-2-f5 (make-s-2))
42             (s-2-f5 (make-s-2))))
43    nil)    nil)
       
44    
45      ;; Creation with various fields does the right thing
46    (deftest structure-2-3
47      (let* ((*s-2-f6-counter* 0)
48             (s (make-s-2 :f1 17)))
49        (and
50         (eqlt (s-2-f1 s) 17)
51         (eqt  (s-2-f2 s) 'a)
52         (= (s-2-f3 s) 1.21)
53         (eqlt (s-2-f4 s) #\d)
54         (equalt (s-2-f5 s) '(a b))
55         (eqlt (s-2-f6 s) *s-2-f6-counter*)
56         (eqlt *s-2-f6-counter* 1)))
57      t)
58    
59    (deftest structure-2-4
60      (let* ((*s-2-f6-counter* 0)
61             (s (make-s-2 :f2 'z)))
62        (and
63         (eqlt (s-2-f1 s) 0)
64         (eqt  (s-2-f2 s) 'z)
65         (= (s-2-f3 s) 1.21)
66         (eqlt (s-2-f4 s) #\d)
67         (equalt (s-2-f5 s) '(a b))
68         (eqlt (s-2-f6 s) *s-2-f6-counter*)
69         (eqlt *s-2-f6-counter* 1)))
70      t)
71    
72    (deftest structure-2-5
73      (let* ((*s-2-f6-counter* 0)
74             (s (make-s-2 :f3 1.0)))
75        (and
76         (eqlt (s-2-f1 s) 0)
77         (eqt  (s-2-f2 s) 'a)
78         (= (s-2-f3 s) 1.0)
79         (eqlt (s-2-f4 s) #\d)
80         (equalt (s-2-f5 s) '(a b))
81         (eqlt (s-2-f6 s) *s-2-f6-counter*)
82         (eqlt *s-2-f6-counter* 1)))
83      t)
84    
85    (deftest structure-2-6
86      (let* ((*s-2-f6-counter* 0)
87             (s (make-s-2 :f4 #\z)))
88        (and
89         (eqlt (s-2-f1 s) 0)
90         (eqt  (s-2-f2 s) 'a)
91         (= (s-2-f3 s) 1.21)
92         (eqlt (s-2-f4 s) #\z)
93         (equalt (s-2-f5 s) '(a b))
94         (eqlt (s-2-f6 s) *s-2-f6-counter*)
95         (eqlt *s-2-f6-counter* 1)))
96      t)
97    
98    (deftest structure-2-7
99      (let* ((*s-2-f6-counter* 0)
100             (s (make-s-2 :f5 '(c d e))))
101        (and
102         (eqlt (s-2-f1 s) 0)
103         (eqt  (s-2-f2 s) 'a)
104         (= (s-2-f3 s) 1.21)
105         (eqlt (s-2-f4 s) #\d)
106         (equalt (s-2-f5 s) '(c d e))
107         (eqlt (s-2-f6 s) *s-2-f6-counter*)
108         (eqlt *s-2-f6-counter* 1)))
109      t)
110    
111    (deftest structure-2-8
112      (let* ((*s-2-f6-counter* 0)
113             (s (make-s-2 :f6 10)))
114        (and
115         (eqlt (s-2-f1 s) 0)
116         (eqt  (s-2-f2 s) 'a)
117         (= (s-2-f3 s) 1.21)
118         (eqlt (s-2-f4 s) #\d)
119         (equalt (s-2-f5 s) '(a b))
120         (eqlt (s-2-f6 s) 10)
121         (eqlt *s-2-f6-counter* 0)))
122      t)
123    
124    ;;; Tests using the defstruct-with-tests infrastructure
125    
126    (defstruct-with-tests struct-test-03 a b c d)
127    
128    (defstruct-with-tests (struct-test-04) a b c)
129    
130    (defstruct-with-tests (struct-test-05 :constructor) a05 b05 c05)
131    (defstruct-with-tests (struct-test-06 (:constructor)) a06 b06 c06)
132    
133    (defstruct-with-tests (struct-test-07 :conc-name) a07 b07)
134    (defstruct-with-tests (struct-test-08 (:conc-name)) a08 b08)
135    (defstruct-with-tests (struct-test-09 (:conc-name nil)) a09 b09)
136    (defstruct-with-tests (struct-test-10 (:conc-name "")) a10 b10)
137    (defstruct-with-tests (struct-test-11 (:conc-name "BLAH-")) a11 b11)
138    
139    ;;; More to come...

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