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

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

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

revision 1.6 by pfdietz, Wed Jan 29 02:11:54 2003 UTC revision 1.7 by pfdietz, Sat Feb 8 06:23:02 2003 UTC
# Line 10  Line 10 
10  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11  ;;; member  ;;; member
12    
13  (deftest member-1  (deftest member.1
14      (let* ((x (copy-tree '(a b c d e f)))    (let* ((x (copy-tree '(a b c d e f)))
15             (xcopy (make-scaffold-copy x))           (xcopy (make-scaffold-copy x))
16             (result (member 'c x)))           (result (member 'c x)))
17        (and      (and
18         (eqt result (cddr x))       (eqt result (cddr x))
19         (check-scaffold-copy x xcopy)))       (check-scaffold-copy x xcopy)))
20    t)    t)
21    
22  (deftest member-2  (deftest member.2
23      (let* ((x (copy-tree '(a b c d e f)))    (let* ((x (copy-tree '(a b c d e f)))
24             (xcopy (make-scaffold-copy x))           (xcopy (make-scaffold-copy x))
25             (result (member 'e x)))           (result (member 'e x)))
26        (and      (and
27         (eqt result (cddddr x))       (eqt result (cddddr x))
28         (check-scaffold-copy x xcopy)))       (check-scaffold-copy x xcopy)))
29    t)    t)
30    
31  (deftest member-3  (deftest member.3
32      (let* ((x (copy-tree '(1 2 3 4 5 6 7)))    (let* ((x (copy-tree '(1 2 3 4 5 6 7)))
33             (xcopy (make-scaffold-copy x))           (xcopy (make-scaffold-copy x))
34             (result (member 4 x)))           (result (member 4 x)))
35        (and      (and
36         (eqt result (cdddr x))       (eqt result (cdddr x))
37         (check-scaffold-copy x xcopy)))       (check-scaffold-copy x xcopy)))
38    t)    t)
39    
40  (deftest member-4  (deftest member.4
41      (let* ((x (copy-tree '(2 4 6 8 10 12)))    (let* ((x (copy-tree '(2 4 6 8 10 12)))
42             (xcopy (make-scaffold-copy x))           (xcopy (make-scaffold-copy x))
43             (result (member 9 x :key #'1+)))           (result (member 9 x :key #'1+)))
44        (and      (and
45         (eqt result (cdddr x))       (eqt result (cdddr x))
46         (check-scaffold-copy x xcopy)))       (check-scaffold-copy x xcopy)))
47    t)    t)
48    
49  (deftest member-5  (deftest member.5
50      (let* ((x (copy-tree '((a b) (c d) (e f) (g h))))    (let* ((x (copy-tree '((a b) (c d) (e f) (g h))))
51             (xcopy (make-scaffold-copy x))           (xcopy (make-scaffold-copy x))
52             (result (member '(c d) x :test #'equal)))           (result (member '(c d) x :test #'equal)))
53        (and      (and
54         (eqt result (cdr x))       (eqt result (cdr x))
55         (check-scaffold-copy x xcopy)))       (check-scaffold-copy x xcopy)))
56    t)    t)
57    
58  (deftest member-6  (deftest member.6
59      (let* ((x (copy-tree '((a b) (c d) (e f) (g h))))    (let* ((x (copy-tree '((a b) (c d) (e f) (g h))))
60             (xcopy (make-scaffold-copy x))           (xcopy (make-scaffold-copy x))
61             (result (member 'c x :key #'car)))           (result (member 'c x :key #'car)))
62        (and      (and
63         (eqt result (cdr x))       (eqt result (cdr x))
64         (check-scaffold-copy x xcopy)))       (check-scaffold-copy x xcopy)))
65    t)    t)
66    
67  (deftest member-7  (deftest member.7
68      (let* ((x (copy-tree '((a b) (c d) (e f) (g h))))    (let* ((x (copy-tree '((a b) (c d) (e f) (g h))))
69             (xcopy (make-scaffold-copy x))           (xcopy (make-scaffold-copy x))
70             (result (member 'c x :key #'car :test #'eq)))           (result (member 'c x :key #'car :test #'eq)))
71        (and      (and
72         (eqt result (cdr x))       (eqt result (cdr x))
73         (check-scaffold-copy x xcopy)))       (check-scaffold-copy x xcopy)))
74    t)    t)
75    
76  (deftest member-8  (deftest member.8
77      (let* ((x (copy-tree '((a b) (c d) (e f) (g h))))    (let* ((x (copy-tree '((a b) (c d) (e f) (g h))))
78             (xcopy (make-scaffold-copy x))           (xcopy (make-scaffold-copy x))
79             (result (member 'c x :key #'car :test-not (complement #'eq))))           (result (member 'c x :key #'car :test-not (complement #'eq))))
80        (and      (and
81         (eqt result (cdr x))       (eqt result (cdr x))
82         (check-scaffold-copy x xcopy)))       (check-scaffold-copy x xcopy)))
83    t)    t)
84    
85  (deftest member-9  (deftest member.9
86      (let* ((x (copy-tree '((a b) (c d) (e f) (g h))))    (let* ((x (copy-tree '((a b) (c d) (e f) (g h))))
87             (xcopy (make-scaffold-copy x))           (xcopy (make-scaffold-copy x))
88             (result (member 'c x :key #'car :test #'eql)))           (result (member 'c x :key #'car :test #'eql)))
89        (and      (and
90         (eqt result (cdr x))       (eqt result (cdr x))
91         (check-scaffold-copy x xcopy)))       (check-scaffold-copy x xcopy)))
92    t)    t)
93    
94  (deftest member-10  (deftest member.10
95      (let* ((x (copy-tree '((a b) (c d) (e f) (g h))))    (let* ((x (copy-tree '((a b) (c d) (e f) (g h))))
96             (xcopy (make-scaffold-copy x))           (xcopy (make-scaffold-copy x))
97             (result (member (list 'd) x :key #'cdr :test #'equal)))           (result (member (list 'd) x :key #'cdr :test #'equal)))
98        (and      (and
99         (eqt result (cdr x))       (eqt result (cdr x))
100         (check-scaffold-copy x xcopy)))       (check-scaffold-copy x xcopy)))
101    t)    t)
102    
103  (deftest member-11  (deftest member.11
104      (member (copy-seq "cc") (copy-tree '("aa" "bb" "cc" "dd" "ee")))    (member (copy-seq "cc") (copy-tree '("aa" "bb" "cc" "dd" "ee")))
105    nil)    nil)
106    
107  (deftest member-12  (deftest member.12
108      (member 1 (copy-tree '(3 4 1 31 423)))    (member 1 (copy-tree '(3 4 1 31 423)))
109    (1 31 423))    (1 31 423))
110    
111  (deftest member-13  (deftest member.13
112      (member (copy-seq "cc") (copy-tree '("aa" "bb" "cc" "dd" "ee"))    (member (copy-seq "cc") (copy-tree '("aa" "bb" "cc" "dd" "ee"))
113              :test #'equal)            :test #'equal)
114    ("cc" "dd" "ee"))    ("cc" "dd" "ee"))
115    
116  (deftest member-14  (deftest member.14
117    (member 'a nil)    (member 'a nil)
118    nil)    nil)
119    
120  (deftest member-15  (deftest member.15
121    (member nil nil)    (member nil nil)
122    nil)    nil)
123    
124  (deftest member-16  (deftest member.16
125    (member nil nil :test #'equal)    (member nil nil :test #'equal)
126    nil)    nil)
127    
128  (deftest member-16-a  (deftest member.16-a
129    (member nil nil :test #'(lambda (x y) (error "Should not call this function")))    (member nil nil :test #'(lambda (x y) (error "Should not call this function")))
130    nil)    nil)
131    
132  (deftest member-17  (deftest member.17
133    (member 'a nil :test #'(lambda (x y) (error "Should not call this function")))    (member 'a nil :test #'(lambda (x y) (error "Should not call this function")))
134    nil)    nil)
135    
136  ;; Check that a null key argument is ignored  ;; Check that a null key argument is ignored
137    
138  (deftest member-18  (deftest member.18
139    (member 'a '(c d a b e) :key nil)    (member 'a '(c d a b e) :key nil)
140    (a b e))    (a b e))
141    
142  (deftest member-19  (deftest member.19
143    (member 'z '(a b c d) :key nil)    (member 'z '(a b c d) :key nil)
144    nil)    nil)
145    
146    ;;; Order of evaluation
147    
148    (deftest member.20
149      (let ((i 0) x y)
150        (values
151         (member (progn (setf x (incf i)) 'c)
152                 (progn (setf y (incf i)) '(a b c d)))
153         i x y))
154      (c d) 2 1 2)
155    
156    (deftest member.21
157      (let ((i 0) x y z p)
158        (values
159         (member (progn (setf x (incf i)) 'c)
160                 (progn (setf y (incf i)) '(a b c d))
161                 :key (progn (setf z (incf i)) #'identity)
162                 :test (progn (setf p (incf i)) #'eq))
163         i x y z p))
164      (c d) 4 1 2 3 4)
165    
166    (deftest member.22
167      (let ((i 0) x y)
168        (values
169         (member (progn (setf x (incf i)) 'c)
170                 (progn (setf y (incf i)) '(a b c d))
171                 :test #'eq)
172         i x y))
173      (c d) 2 1 2)
174    
175    (deftest member.23
176      (let ((i 0) x y z p q)
177        (values
178         (member (progn (setf x (incf i)) 'c)
179                 (progn (setf y (incf i)) '(a b c d))
180                 :key (progn (setf z (incf i)) #'identity)
181                 :test (progn (setf p (incf i)) #'eq)
182                 :key (progn (setf q (incf i)) (constantly 'z)))
183         i x y z p q))
184      (c d) 5 1 2 3 4 5)
185    
186    (deftest member.24
187      (let ((i 0) x y z q)
188        (values
189         (member (progn (setf x (incf i)) 'c)
190                 (progn (setf y (incf i)) '(a b c d))
191                 :test #'eq
192                 :key (progn (setf z (incf i)) #'identity)
193                 :key (progn (setf q (incf i)) (constantly 'z)))
194         i x y z q))
195      (c d) 4 1 2 3 4)
196    
197    
198  ;;; Keyword tests  ;;; Keyword tests
199    
200  (deftest member.allow-other-keys.1  (deftest member.allow-other-keys.1

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7

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