/[gcl]/gcl/ansi-tests/cons-test-18.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/cons-test-18.lsp

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

revision 1.3 by pfdietz, Thu Oct 17 13:16:56 2002 UTC revision 1.4 by pfdietz, Tue Oct 22 05:36:04 2002 UTC
# Line 89  Line 89 
89        (setf (getf p 'c) 3)        (setf (getf p 'c) 3)
90        ;; Must check that only a, b, c have properties        ;; Must check that only a, b, c have properties
91        (and        (and
92         (eql (getf p 'a) 1)         (eqlt (getf p 'a) 1)
93         (eql (getf p 'b) 2)         (eqlt (getf p 'b) 2)
94         (eql (getf p 'c) 3)         (eqlt (getf p 'c) 3)
95         (eql         (eqlt
96          (loop          (loop
97              for ptr on p by #'cddr count              for ptr on p by #'cddr count
98                (not (member (car ptr) '(a b c))))                (not (member (car ptr) '(a b c))))
# Line 105  Line 105 
105        (setf (getf p 'a) 3)        (setf (getf p 'a) 3)
106        ;; Must check that only a, b have properties        ;; Must check that only a, b have properties
107        (and        (and
108         (eql (getf p 'a) 3)         (eqlt (getf p 'a) 3)
109         (eql (getf p 'b) 2)         (eqlt (getf p 'b) 2)
110         (eql         (eqlt
111          (loop          (loop
112              for ptr on p by #'cddr count              for ptr on p by #'cddr count
113                (not (member (car ptr) '(a b))))                (not (member (car ptr) '(a b))))
# Line 120  Line 120 
120        (setf (getf p 'c 17) 3)        (setf (getf p 'c 17) 3)
121        ;; Must check that only a, b, c have properties        ;; Must check that only a, b, c have properties
122        (and        (and
123         (eql (getf p 'a) 1)         (eqlt (getf p 'a) 1)
124         (eql (getf p 'b) 2)         (eqlt (getf p 'b) 2)
125         (eql (getf p 'c) 3)         (eqlt (getf p 'c) 3)
126         (eql         (eqlt
127          (loop          (loop
128              for ptr on p by #'cddr count              for ptr on p by #'cddr count
129                (not (member (car ptr) '(a b c))))                (not (member (car ptr) '(a b c))))
# Line 136  Line 136 
136        (setf (getf p 'a 17) 3)        (setf (getf p 'a 17) 3)
137        ;; Must check that only a, b have properties        ;; Must check that only a, b have properties
138        (and        (and
139         (eql (getf p 'a) 3)         (eqlt (getf p 'a) 3)
140         (eql (getf p 'b) 2)         (eqlt (getf p 'b) 2)
141         (eql         (eqlt
142          (loop          (loop
143              for ptr on p by #'cddr count              for ptr on p by #'cddr count
144                (not (member (car ptr) '(a b))))                (not (member (car ptr) '(a b))))
# Line 152  Line 152 
152        (setf (getf p 'a (progn (setf foo t) 0)) 3)        (setf (getf p 'a (progn (setf foo t) 0)) 3)
153        ;; Must check that only a, b have properties        ;; Must check that only a, b have properties
154        (and        (and
155         (eql (getf p 'a) 3)         (eqlt (getf p 'a) 3)
156         (eql (getf p 'b) 2)         (eqlt (getf p 'b) 2)
157         (eql         (eqlt
158          (loop          (loop
159              for ptr on p by #'cddr count              for ptr on p by #'cddr count
160                (not (member (car ptr) '(a b))))                (not (member (car ptr) '(a b))))
# Line 162  Line 162 
162         foo))         foo))
163    t)    t)
164    
165    (deftest setf-getf-6
166        (let ((p (list (copy-list '(a 1 b 2))))
167              (cnt1 0) (cnt2 0))
168          (setf (getf (car (progn (incf cnt1) p)) 'c)
169                (progn (incf cnt2) 3))
170          ;; Must check that only a, b, c have properties
171          (and
172           (eqlt cnt1 1)
173           (eqlt cnt2 1)
174           (eqlt (getf (car p) 'a) 1)
175           (eqlt (getf (car p) 'b) 2)
176           (eqlt (getf (car p) 'c) 3)
177           (eqlt
178            (loop
179                for ptr on (car p) by #'cddr count
180                  (not (member (car ptr) '(a b c))))
181            0)
182           t))
183      t)
184    
185  (deftest incf-getf-1  (deftest incf-getf-1
186      (let ((p (copy-list '(a 1 b 2))))      (let ((p (copy-list '(a 1 b 2))))
187        (incf (getf p 'b))        (incf (getf p 'b))
188        ;; Must check that only a, b have properties        ;; Must check that only a, b have properties
189        (and        (and
190         (eql (getf p 'a) 1)         (eqlt (getf p 'a) 1)
191         (eql (getf p 'b) 3)         (eqlt (getf p 'b) 3)
192         (eql         (eqlt
193          (loop          (loop
194              for ptr on p by #'cddr count              for ptr on p by #'cddr count
195                (not (member (car ptr) '(a b))))                (not (member (car ptr) '(a b))))
# Line 182  Line 202 
202        (incf (getf p 'c 19))        (incf (getf p 'c 19))
203        ;; Must check that only a, b have properties        ;; Must check that only a, b have properties
204        (and        (and
205         (eql (getf p 'a) 1)         (eqlt (getf p 'a) 1)
206         (eql (getf p 'b) 2)         (eqlt (getf p 'b) 2)
207         (eql (getf p 'c) 20)         (eqlt (getf p 'c) 20)
208         (eql         (eqlt
209          (loop          (loop
210              for ptr on p by #'cddr count              for ptr on p by #'cddr count
211                (not (member (car ptr) '(a b c))))                (not (member (car ptr) '(a b c))))

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

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