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

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

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

revision 1.8 by pfdietz, Fri Jan 24 04:22:54 2003 UTC revision 1.9 by pfdietz, Mon Feb 10 03:09:37 2003 UTC
# Line 12  Line 12 
12    
13  (defvar cons-test-24-var '(78 "z" (8 9)))  (defvar cons-test-24-var '(78 "z" (8 9)))
14    
15  (deftest subsetp-1  (deftest subsetp.1
16      (subsetp-with-check (copy-tree '(78)) cons-test-24-var)    (subsetp-with-check (copy-tree '(78)) cons-test-24-var)
17    t)    t)
18    
19  (deftest subsetp-2  (deftest subsetp.2
20      (subsetp-with-check (copy-tree '((8 9))) cons-test-24-var)    (subsetp-with-check (copy-tree '((8 9))) cons-test-24-var)
21    nil)    nil)
22    
23  (deftest subsetp-3  (deftest subsetp.3
24      (subsetp-with-check (copy-tree '((8 9)))    (subsetp-with-check (copy-tree '((8 9)))
25                          cons-test-24-var :test 'equal)                        cons-test-24-var :test 'equal)
26    t)    t)
27    
28  (deftest subsetp-4  (deftest subsetp.4
29      (subsetp-with-check (list 78 (copy-seq "Z")) cons-test-24-var    (subsetp-with-check (list 78 (copy-seq "Z")) cons-test-24-var
30                          :test #'equalp)                        :test #'equalp)
31    t)    t)
32    
33  (deftest subsetp-5  (deftest subsetp.5
34      (subsetp-with-check (list 1) (list 0 2 3 4)    (subsetp-with-check (list 1) (list 0 2 3 4)
35                          :key #'(lambda (i) (floor (/ i 2))))                        :key #'(lambda (i) (floor (/ i 2))))
36    t)    t)
37    
38  (deftest subsetp-6  (deftest subsetp.6
39      (subsetp-with-check (list 1 6) (list 0 2 3 4)    (subsetp-with-check (list 1 6) (list 0 2 3 4)
40                          :key #'(lambda (i) (floor (/ i 2))))                        :key #'(lambda (i) (floor (/ i 2))))
41    nil)    nil)
42    
43  (deftest subsetp-7  (deftest subsetp.7
44      (subsetp-with-check (list '(a . 10) '(b . 20) '(c . 30))    (subsetp-with-check (list '(a . 10) '(b . 20) '(c . 30))
45                          (list '(z . c) '(a . y) '(b . 100) '(e . f)                        (list '(z . c) '(a . y) '(b . 100) '(e . f)
46                                '(c . foo))                              '(c . foo))
47                          :key #'car)                        :key #'car)
   t)  
   
 (deftest subsetp-8  
     (subsetp-with-check (copy-tree '((a . 10) (b . 20) (c . 30)))  
                         (copy-tree '((z . c) (a . y) (b . 100) (e . f)  
                               (c . foo)))  
                         :key 'car)  
   t)  
   
 (deftest subsetp-9  
     (subsetp-with-check (list 'a 'b 'c)  
                         (copy-tree  
                          (list '(z . c) '(a . y) '(b . 100) '(e . f)  
                               '(c . foo)))  
                         :test #'(lambda (e1 e2)  
                                    (eqt e1 (car e2))))  
48    t)    t)
49    
50  (deftest subsetp-10  (deftest subsetp.8
51      (subsetp-with-check (copy-tree '((a . 10) (b . 20) (c . 30)))
52                          (copy-tree '((z . c) (a . y) (b . 100) (e . f)
53                                       (c . foo)))
54                          :key 'car)
55      t)
56    
57    (deftest subsetp.9
58      (subsetp-with-check (list 'a 'b 'c)
59                          (copy-tree
60                           (list '(z . c) '(a . y) '(b . 100) '(e . f)
61                                 '(c . foo)))
62                          :test #'(lambda (e1 e2)
63                                    (eqt e1 (car e2))))
64      t)
65    
66    (deftest subsetp.10
67    (subsetp-with-check (list 'a 'b 'c)    (subsetp-with-check (list 'a 'b 'c)
68                        (copy-tree                        (copy-tree
69                         (list '(z . c) '(a . y) '(b . 100) '(e . f)                         (list '(z . c) '(a . y) '(b . 100) '(e . f)
# Line 73  Line 73 
73                        :key nil)                        :key nil)
74    t)    t)
75    
76  (deftest subsetp-11  (deftest subsetp.11
77      (subsetp-with-check (list 'a 'b 'c)    (subsetp-with-check (list 'a 'b 'c)
78                          (copy-tree                        (copy-tree
79                           (list '(z . c) '(a . y) '(b . 100) '(e . f)                         (list '(z . c) '(a . y) '(b . 100) '(e . f)
80                                 '(c . foo)))                               '(c . foo)))
81                          :test-not  #'(lambda (e1 e2)                        :test-not  #'(lambda (e1 e2)
82                                         (not (eqt e1 (car e2)))))                                       (not (eqt e1 (car e2)))))
83    t)    t)
84    
85  ;; Check that it maintains order of arguments  ;; Check that it maintains order of arguments
86    
87  (deftest subsetp-12  (deftest subsetp.12
88      (block fail    (block fail
89        (subsetp-with-check      (subsetp-with-check
90         (list 1 2 3)       (list 1 2 3)
91         (list 4 5 6)       (list 4 5 6)
92         :test #'(lambda (x y)       :test #'(lambda (x y)
93                   (when (< y x) (return-from fail 'fail))                 (when (< y x) (return-from fail 'fail))
94                   t)))                 t)))
95    t)    t)
96    
97  (deftest subsetp-13  (deftest subsetp.13
98      (block fail    (block fail
99        (subsetp-with-check      (subsetp-with-check
100         (list 1 2 3)       (list 1 2 3)
101         (list 4 5 6)       (list 4 5 6)
102         :key #'identity       :key #'identity
103         :test #'(lambda (x y)       :test #'(lambda (x y)
104                   (when (< y x) (return-from fail 'fail))                 (when (< y x) (return-from fail 'fail))
105                   t)))                 t)))
106    t)    t)
107    
108  (deftest subsetp-14  (deftest subsetp.14
109      (block fail    (block fail
110        (subsetp-with-check      (subsetp-with-check
111         (list 1 2 3)       (list 1 2 3)
112         (list 4 5 6)       (list 4 5 6)
113         :test-not #'(lambda (x y)       :test-not #'(lambda (x y)
114                   (when (< y x) (return-from fail 'fail))                     (when (< y x) (return-from fail 'fail))
115                   nil)))                     nil)))
116    t)    t)
117    
118  (deftest subsetp-15  (deftest subsetp.15
119      (block fail    (block fail
120        (subsetp-with-check      (subsetp-with-check
121         (list 1 2 3)       (list 1 2 3)
122         (list 4 5 6)       (list 4 5 6)
123         :key #'identity       :key #'identity
124         :test-not #'(lambda (x y)       :test-not #'(lambda (x y)
125                   (when (< y x) (return-from fail 'fail))                     (when (< y x) (return-from fail 'fail))
126                   nil)))                     nil)))
127    t)    t)
128    
129    ;;; Order of argument evaluation tests
130    
131    (deftest subsetp.16
132      (let ((i 0) x y)
133        (values
134         (notnot (subsetp (progn (setf x (incf i))
135                                 '(a b c))
136                          (progn (setf y (incf i))
137                                 '(a b c d))))
138         i x y))
139      t 2 1 2)
140    
141    (deftest subsetp.17
142      (let ((i 0) x y z w)
143        (values
144         (notnot (subsetp (progn (setf x (incf i))
145                                 '(a b c))
146                          (progn (setf y (incf i))
147                                 '(a b c d))
148                          :test (progn (setf z (incf i)) #'eql)
149                          :key  (progn (setf w (incf i)) nil)))
150         i x y z w))
151      t 4 1 2 3 4)
152    
153    (deftest subsetp.18
154      (let ((i 0) x y z w)
155        (values
156         (notnot (subsetp (progn (setf x (incf i))
157                                 '(a b c))
158                          (progn (setf y (incf i))
159                                 '(a b c d))
160                          :key  (progn (setf z (incf i)) nil)
161                          :test (progn (setf w (incf i)) #'eql)))
162         i x y z w))
163      t 4 1 2 3 4)
164    
165    
166    
167  ;;; Keyword tests  ;;; Keyword tests
168    

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

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