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

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

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

revision 1.1 by pfdietz, Thu Sep 26 16:53:37 2002 UTC revision 1.2 by pfdietz, Thu Oct 17 13:16:56 2002 UTC
# Line 16  Line 16 
16             (result (acons 'a 'b x)))             (result (acons 'a 'b x)))
17        (and        (and
18         (check-scaffold-copy x xcopy)         (check-scaffold-copy x xcopy)
19         (eq (cdr result) x)         (eqt (cdr result) x)
20         result))         result))
21    ((a . b) (c . d) (e . f)))    ((a . b) (c . d) (e . f)))
22    
# Line 72  Line 72 
72             (xcopy (make-scaffold-copy x))             (xcopy (make-scaffold-copy x))
73             (result (assoc 'b x)))             (result (assoc 'b x)))
74        (and        (and
75         (eq result (second x))         (eqt result (second x))
76         (check-scaffold-copy x xcopy)))         (check-scaffold-copy x xcopy)))
77    t)    t)
78    
# Line 165  Line 165 
165    
166  (deftest assoc-24  (deftest assoc-24
167      (assoc 'a '((b . 1) (a . 2) (c . 3))      (assoc 'a '((b . 1) (a . 2) (c . 3))
168             :test #'(lambda (x y) (and (eq x y) 'matched)))             :test #'(lambda (x y) (and (eqt x y) 'matched)))
169    (a . 2))    (a . 2))
170    
171  ;; Check that the order of the arguments to test is correct  ;; Check that the order of the arguments to test is correct
# Line 174  Line 174 
174      (block fail      (block fail
175        (assoc 'a '((b . 1) (c . 2) (a . 3))        (assoc 'a '((b . 1) (c . 2) (a . 3))
176               :test #'(lambda (x y)               :test #'(lambda (x y)
177                         (unless (eq x 'a) (return-from fail 'fail))                         (unless (eqt x 'a) (return-from fail 'fail))
178                         (eq x y))))                         (eqt x y))))
179    (A . 3))    (A . 3))
180    
181  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
# Line 187  Line 187 
187             (result (assoc-if #'evenp x)))             (result (assoc-if #'evenp x)))
188        (and        (and
189         (check-scaffold-copy x xcopy)         (check-scaffold-copy x xcopy)
190         (eq result (third x))         (eqt result (third x))
191         result))         result))
192    (6 . c))    (6 . c))
193    
# Line 198  Line 198 
198                 (result (assoc-if #'oddp x :key #'1+)))                 (result (assoc-if #'oddp x :key #'1+)))
199            (and            (and
200             (check-scaffold-copy x xcopy)             (check-scaffold-copy x xcopy)
201             (eq result (third x))             (eqt result (third x))
202             result))             result))
203        (program-error (c) c))        (program-error (c) c))
204    (6 . c))    (6 . c))
# Line 209  Line 209 
209             (result (assoc-if #'evenp x)))             (result (assoc-if #'evenp x)))
210        (and        (and
211         (check-scaffold-copy x xcopy)         (check-scaffold-copy x xcopy)
212         (eq result (fourth x))         (eqt result (fourth x))
213         result))         result))
214    (6 . c))    (6 . c))
215    
# Line 226  Line 226 
226             (result (assoc-if-not #'oddp x)))             (result (assoc-if-not #'oddp x)))
227        (and        (and
228         (check-scaffold-copy x xcopy)         (check-scaffold-copy x xcopy)
229         (eq result (third x))         (eqt result (third x))
230         result))         result))
231    (6 . c))    (6 . c))
232    
# Line 237  Line 237 
237                 (result (assoc-if-not #'evenp x :key #'1+)))                 (result (assoc-if-not #'evenp x :key #'1+)))
238            (and            (and
239             (check-scaffold-copy x xcopy)             (check-scaffold-copy x xcopy)
240             (eq result (third x))             (eqt result (third x))
241             result))             result))
242        (program-error (c) c))        (program-error (c) c))
243    (6 . c))    (6 . c))
# Line 248  Line 248 
248             (result (assoc-if-not #'oddp x)))             (result (assoc-if-not #'oddp x)))
249        (and        (and
250         (check-scaffold-copy x xcopy)         (check-scaffold-copy x xcopy)
251         (eq result (fourth x))         (eqt result (fourth x))
252         result))         result))
253    (6 . c))    (6 . c))
254    
# Line 270  Line 270 
270         (= (length x) (length result))         (= (length x) (length result))
271         (every #'(lambda (p1 p2)         (every #'(lambda (p1 p2)
272                    (or (and (null p1) (null p2))                    (or (and (null p1) (null p2))
273                        (and (not (eq p1 p2))                        (and (not (eqt p1 p2))
274                             (eq (car p1) (car p2))                             (eqt (car p1) (car p2))
275                             (eq (cdr p1) (cdr p2)))))                             (eqt (cdr p1) (cdr p2)))))
276                x result)                x result)
277         t))         t))
278    t)    t)
# Line 328  Line 328 
328         (check-scaffold-copy x xcopy)         (check-scaffold-copy x xcopy)
329         (check-scaffold-copy y ycopy)         (check-scaffold-copy y ycopy)
330         (check-scaffold-copy z zcopy)         (check-scaffold-copy z zcopy)
331         (eq (cdr (cddr (cddr result))) z)         (eqt (cdr (cddr (cddr result))) z)
332         (or         (or
333          (equal result expected)          (equal result expected)
334          (equal result (append (reverse (subseq expected 0 5))          (equal result (append (reverse (subseq expected 0 5))

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

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