source: trunk/source/tests/ansi-tests/equalp.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 7.0 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Thu Oct 17 22:14:42 2002
4;;;; Contains: Tests for EQUALP
5
6(in-package :cl-test)
7
8(compile-and-load "random-aux.lsp")
9
10(deftest equalp.1
11  (loop for c across +base-chars+
12        always (loop for d across +base-chars+
13                     always (if (char-equal c d) (equalpt c d)
14                              (not (equalpt c d)))))
15  t)
16
17(deftest equalp.2
18  (loop for i from 1 to 100
19        always (loop for j from 1 to 100
20                     always (if (eqlt i j) (equalpt i j)
21                              (not (equalpt i j)))))
22  t)
23
24(deftest equalp.3
25  (equalpt "abc" "ABC")
26  t)
27
28(deftest equalp.4
29  (equalpt "abc" "abd")
30  nil)
31
32(deftest equalp.5
33  :notes (:allow-nil-arrays)
34  (equalpt (make-array '(0) :element-type nil) #())
35  t)
36
37(deftest equalp.6
38  :notes (:allow-nil-arrays)
39  (equalpt (make-array '(0) :element-type nil) "")
40  t)
41
42(deftest equalp.7
43  (loop for nbits from 1 to 100
44        for type = `(unsigned-byte ,nbits)
45        for bound = (ash 1 nbits)
46        for val = (random bound)
47        for a1 = (make-array nil :initial-element val :element-type type)
48        for a2 = (make-array nil :initial-element val)
49        unless (equalp a1 a2)
50        collect (list nbits type val))
51  nil)
52
53(deftest equalp.8
54  (loop for nbits from 1 to 100
55        for type = `(unsigned-byte ,nbits)
56        for bound = (ash 1 nbits)
57        for n = (1+ (random 20))
58        for vals = (loop repeat n collect (random bound))
59        for a1 = (make-array n :initial-contents vals :element-type type)
60        for a2 = (make-array n :initial-contents vals)
61        unless (equalp a1 a2)
62        collect (list nbits type vals))
63  nil)
64
65(deftest equalp.9
66  (loop for nbits from 1 to 100
67        for type = `(signed-byte ,nbits)
68        for bound = (ash 1 nbits)
69        for n = (1+ (random 20))
70        for vals = (loop repeat n collect (- (random bound) (/ bound 2)))
71        for a1 = (make-array n :initial-contents vals :element-type type)
72        for a2 = (make-array n :initial-contents vals)
73        unless (equalp a1 a2)
74        collect (list nbits type vals))
75  nil)
76
77(deftest equalp.10
78  (equalpt #*0010 #(0 0 1 0))
79  t)
80
81(deftest equalp.11
82  (let ((v1 #(1 2 3))
83        (v2 (make-array 8 :initial-contents '(1 2 3 4 5 6 7 8)
84                        :fill-pointer 3)))
85    (equalpt v1 v2))
86  t)
87
88(deftest equalp.12
89  (equalpt '(#\a #\b) "ab")
90  nil)
91
92(deftest equalp.13
93  (equalpt '(#\a #\b) '(#\A #\B))
94  t)
95
96(deftest equalp.14
97  (let ((s1 (make-array '(4) :initial-contents '(#\a #\b #\c #\d)
98                        :element-type 'base-char))
99        (s2 (make-array '(4) :initial-contents '(#\a #\b #\c #\d)
100                        :element-type 'character)))
101    (equalpt s1 s2))
102  t)
103
104(deftest equalp.15
105  (let ((bv (make-array '(4) :initial-contents '(0 0 1 0)
106                        :element-type 'bit))
107        (v #(0 0 1 0)))
108    (equalpt bv v))
109  t)
110
111(defstruct equalp-struct-16
112  a b c)
113
114(defstruct equalp-struct-16-alt
115  a b c)
116
117(deftest equalp.16
118  (let ((s1 (make-equalp-struct-16 :a 1 :b 2 :c #\a))
119        (s2 (make-equalp-struct-16 :a 1.0 :b 2.0 :c #\A))
120        (s3 (make-equalp-struct-16-alt :a 1.0 :b 2.0 :c #\A)))
121    (values (equalpt s1 s2)
122            (equalpt s1 s3)
123            (equalpt s2 s3)))
124  t nil nil)
125
126(deftest equalp.17
127  (loop for i below 8192
128        for f = (float i 1.0s0)
129        repeat 1000
130        unless (equalp i f)
131        collect (list i f))
132  nil)
133
134(deftest equalp.18
135  (loop for i = (- (random 10000000) 5000000)
136        for f = (float i 1.0f0)
137        repeat 1000
138        unless (equalp i f)
139        collect (list i f))
140  nil)
141
142(deftest equalp.19
143  (loop for i = (- (random 10000000) 5000000)
144        for f = (float i 1.0d0)
145        repeat 1000
146        unless (equalp i f)
147        collect (list i f))
148  nil)
149
150(deftest equalp.20
151  (loop for i = (- (random 10000000) 5000000)
152        for f = (float i 1.0l0)
153        repeat 1000
154        unless (equalp i f)
155        collect (list i f))
156  nil)
157
158(deftest equalp.21
159  (let ((ht1 (make-hash-table :test #'eq))
160        (ht2 (make-hash-table :test #'eql))
161        (ht3 (make-hash-table :test #'equal))
162        (ht4 (make-hash-table :test #'equalp)))
163    (values (equalpt ht1 ht2)
164            (equalpt ht1 ht3)
165            (equalpt ht1 ht4)
166            (equalpt ht2 ht3)
167            (equalpt ht2 ht4)
168            (equalpt ht3 ht4)))
169  nil nil nil nil nil nil)
170
171(deftest equalp.22
172  (equalpt (make-hash-table :test 'eq)
173           (make-hash-table :test #'eq))
174  t)
175
176(deftest equalp.23
177  (equalpt (make-hash-table :test 'eql)
178           (make-hash-table :test #'eql))
179  t)
180
181(deftest equalp.24
182  (equalpt (make-hash-table :test 'equal)
183           (make-hash-table :test #'equal))
184  t)
185
186(deftest equalp.25
187  (equalpt (make-hash-table :test 'equalp)
188           (make-hash-table :test #'equalp))
189  t)
190
191(deftest equalp.26
192  (let ((ht1 (make-hash-table :test #'eq))
193        (ht2 (make-hash-table :test #'eq)))
194    (setf (gethash #\a ht1) t)
195    (setf (gethash #\A ht2) t)
196    (equalpt ht1 ht2))
197  nil)
198
199(deftest equalp.27
200  (let ((ht1 (make-hash-table :test #'eq))
201        (ht2 (make-hash-table :test #'eq)))
202    (setf (gethash 'a ht1) #\a)
203    (setf (gethash 'a ht2) #\A)
204    (equalpt ht1 ht2))
205  t)
206
207(deftest equalp.28
208  (let ((ht1 (make-hash-table :test #'eql))
209        (ht2 (make-hash-table :test #'eql)))
210    (setf (gethash #\a ht1) t)
211    (setf (gethash #\A ht2) t)
212    (equalpt ht1 ht2))
213  nil)
214
215(deftest equalp.29
216  (let ((ht1 (make-hash-table :test #'eql))
217        (ht2 (make-hash-table :test #'eql)))
218    (setf (gethash #\a ht1) "a")
219    (setf (gethash #\a ht2) "A")
220    (equalpt ht1 ht2))
221  t)
222
223(deftest equalp.30
224  (let ((ht1 (make-hash-table :test #'equal))
225        (ht2 (make-hash-table :test #'equal)))
226    (setf (gethash #\a ht1) t)
227    (setf (gethash #\A ht2) t)
228    (equalpt ht1 ht2))
229  nil)
230
231(deftest equalp.31
232  (let ((ht1 (make-hash-table :test #'equal))
233        (ht2 (make-hash-table :test #'equal)))
234    (setf (gethash #\a ht1) "a")
235    (setf (gethash #\a ht2) "A")
236    (equalpt ht1 ht2))
237  t)
238
239(deftest equalp.32
240  (let ((ht1 (make-hash-table :test #'equalp))
241        (ht2 (make-hash-table :test #'equalp)))
242    (setf (gethash #\a ht1) t)
243    (setf (gethash #\A ht2) t)
244    (equalpt ht1 ht2))
245  t)
246
247(deftest equalp.33
248  (let ((ht1 (make-hash-table :test #'equalp))
249        (ht2 (make-hash-table :test #'equalp)))
250    (setf (gethash #\a ht1) "a")
251    (setf (gethash #\a ht2) "A")
252    (equalpt ht1 ht2))
253  t)
254
255(deftest equalp.34
256  (let ((ht1 (make-hash-table :test #'equalp))
257        (ht2 (make-hash-table :test #'equalp)))
258    (setf (gethash '#:a ht1) t)
259    (setf (gethash '#:a ht2) t)
260    (equalpt ht1 ht2))
261  nil)
262
263(deftest equalp.35
264  (loop for test in '(eq eql equal equalp)
265        collect
266        (flet ((%make-table
267                ()
268                (apply #'make-hash-table
269                       :test test
270                       `(,@(when (coin)
271                             (list :size (random 100)))
272                           ,@(when (coin)
273                               (list :rehash-size (1+ (random 50))))
274                           ,@(when (coin)
275                               (list :rehash-threshold (random 1.0)) )))))
276          (loop repeat 200
277                count
278                (let ((ht1 (%make-table))
279                      (ht2 (%make-table))
280                      (pairs (loop for i below (random 100) collect (cons (gensym) i))))
281                  (loop for (k . v) in pairs do (setf (gethash k ht1) v))
282                  (setf pairs (random-permute pairs))
283                  (loop for (k . v) in pairs do (setf (gethash k ht2) v))
284                  (not (equalp ht1 ht2))))))
285  (0 0 0 0))
286
287(deftest equalp.order.1
288  (let ((i 0) x y)
289    (values
290     (equalp (setf x (incf i)) (setf y (incf i)))
291     i x y))
292  nil 2 1 2)
293
294;;; Error tests
295
296(deftest equalp.error.1
297  (signals-error (equalp) program-error)
298  t)
299
300(deftest equalp.error.2
301  (signals-error (equalp nil) program-error)
302  t)
303
304(deftest equalp.error.3
305  (signals-error (equalp nil nil nil) program-error)
306  t)
Note: See TracBrowser for help on using the repository browser.