equalp.lsp 8.24 KB
Newer Older
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Thu Oct 17 22:14:42 2002
;;;; Contains: Tests for EQUALP

6

7 8 9

(deftest equalp.1
  (loop for c across +base-chars+
sds's avatar
sds committed
10 11 12
        always (loop for d across +base-chars+
                     always (if (char-equal c d) (equalpt c d)
                              (not (equalpt c d)))))
13 14 15 16
  t)

(deftest equalp.2
  (loop for i from 1 to 100
sds's avatar
sds committed
17 18 19
        always (loop for j from 1 to 100
                     always (if (eqlt i j) (equalpt i j)
                              (not (equalpt i j)))))
20 21 22 23 24 25 26 27 28 29
  t)

(deftest equalp.3
  (equalpt "abc" "ABC")
  t)

(deftest equalp.4
  (equalpt "abc" "abd")
  nil)

30
(deftest equalp.5
31
  :notes (:allow-nil-arrays)
32 33 34 35
  (equalpt (make-array '(0) :element-type nil) #())
  t)

(deftest equalp.6
36
  :notes (:allow-nil-arrays)
37 38 39
  (equalpt (make-array '(0) :element-type nil) "")
  t)

pfdietz's avatar
pfdietz committed
40 41
(deftest equalp.7
  (loop for nbits from 1 to 100
sds's avatar
sds committed
42 43 44 45 46 47 48
        for type = `(unsigned-byte ,nbits)
        for bound = (ash 1 nbits)
        for val = (random bound)
        for a1 = (make-array nil :initial-element val :element-type type)
        for a2 = (make-array nil :initial-element val)
        unless (equalp a1 a2)
        collect (list nbits type val))
pfdietz's avatar
pfdietz committed
49 50 51 52
  nil)

(deftest equalp.8
  (loop for nbits from 1 to 100
sds's avatar
sds committed
53 54 55 56 57 58 59 60
        for type = `(unsigned-byte ,nbits)
        for bound = (ash 1 nbits)
        for n = (1+ (random 20))
        for vals = (loop repeat n collect (random bound))
        for a1 = (make-array n :initial-contents vals :element-type type)
        for a2 = (make-array n :initial-contents vals)
        unless (equalp a1 a2)
        collect (list nbits type vals))
pfdietz's avatar
pfdietz committed
61 62 63 64
  nil)

(deftest equalp.9
  (loop for nbits from 1 to 100
sds's avatar
sds committed
65 66 67 68 69 70 71 72
        for type = `(signed-byte ,nbits)
        for bound = (ash 1 nbits)
        for n = (1+ (random 20))
        for vals = (loop repeat n collect (- (random bound) (/ bound 2)))
        for a1 = (make-array n :initial-contents vals :element-type type)
        for a2 = (make-array n :initial-contents vals)
        unless (equalp a1 a2)
        collect (list nbits type vals))
pfdietz's avatar
pfdietz committed
73 74 75 76 77 78 79 80
  nil)

(deftest equalp.10
  (equalpt #*0010 #(0 0 1 0))
  t)

(deftest equalp.11
  (let ((v1 #(1 2 3))
sds's avatar
sds committed
81 82
        (v2 (make-array 8 :initial-contents '(1 2 3 4 5 6 7 8)
                        :fill-pointer 3)))
pfdietz's avatar
pfdietz committed
83 84 85 86 87 88 89 90 91 92 93 94 95
    (equalpt v1 v2))
  t)

(deftest equalp.12
  (equalpt '(#\a #\b) "ab")
  nil)

(deftest equalp.13
  (equalpt '(#\a #\b) '(#\A #\B))
  t)

(deftest equalp.14
  (let ((s1 (make-array '(4) :initial-contents '(#\a #\b #\c #\d)
sds's avatar
sds committed
96 97 98
                        :element-type 'base-char))
        (s2 (make-array '(4) :initial-contents '(#\a #\b #\c #\d)
                        :element-type 'character)))
pfdietz's avatar
pfdietz committed
99 100 101 102 103
    (equalpt s1 s2))
  t)

(deftest equalp.15
  (let ((bv (make-array '(4) :initial-contents '(0 0 1 0)
sds's avatar
sds committed
104 105
                        :element-type 'bit))
        (v #(0 0 1 0)))
pfdietz's avatar
pfdietz committed
106 107 108 109 110 111 112 113 114 115 116
    (equalpt bv v))
  t)

(defstruct equalp-struct-16
  a b c)

(defstruct equalp-struct-16-alt
  a b c)

(deftest equalp.16
  (let ((s1 (make-equalp-struct-16 :a 1 :b 2 :c #\a))
sds's avatar
sds committed
117 118
        (s2 (make-equalp-struct-16 :a 1.0 :b 2.0 :c #\A))
        (s3 (make-equalp-struct-16-alt :a 1.0 :b 2.0 :c #\A)))
pfdietz's avatar
pfdietz committed
119
    (values (equalpt s1 s2)
sds's avatar
sds committed
120 121
            (equalpt s1 s3)
            (equalpt s2 s3)))
pfdietz's avatar
pfdietz committed
122 123 124
  t nil nil)

(deftest equalp.17
125
  (loop for i below 8192
sds's avatar
sds committed
126 127 128 129
        for f = (float i 1.0s0)
        repeat 1000
        unless (equalp i f)
        collect (list i f))
pfdietz's avatar
pfdietz committed
130 131 132 133
  nil)

(deftest equalp.18
  (loop for i = (- (random 10000000) 5000000)
sds's avatar
sds committed
134 135 136 137
        for f = (float i 1.0f0)
        repeat 1000
        unless (equalp i f)
        collect (list i f))
pfdietz's avatar
pfdietz committed
138 139 140 141
  nil)

(deftest equalp.19
  (loop for i = (- (random 10000000) 5000000)
sds's avatar
sds committed
142 143 144 145
        for f = (float i 1.0d0)
        repeat 1000
        unless (equalp i f)
        collect (list i f))
pfdietz's avatar
pfdietz committed
146 147 148 149
  nil)

(deftest equalp.20
  (loop for i = (- (random 10000000) 5000000)
sds's avatar
sds committed
150 151 152 153
        for f = (float i 1.0l0)
        repeat 1000
        unless (equalp i f)
        collect (list i f))
pfdietz's avatar
pfdietz committed
154 155 156 157
  nil)

(deftest equalp.21
  (let ((ht1 (make-hash-table :test #'eq))
sds's avatar
sds committed
158 159 160
        (ht2 (make-hash-table :test #'eql))
        (ht3 (make-hash-table :test #'equal))
        (ht4 (make-hash-table :test #'equalp)))
pfdietz's avatar
pfdietz committed
161
    (values (equalpt ht1 ht2)
sds's avatar
sds committed
162 163 164 165 166
            (equalpt ht1 ht3)
            (equalpt ht1 ht4)
            (equalpt ht2 ht3)
            (equalpt ht2 ht4)
            (equalpt ht3 ht4)))
pfdietz's avatar
pfdietz committed
167 168 169 170
  nil nil nil nil nil nil)

(deftest equalp.22
  (equalpt (make-hash-table :test 'eq)
sds's avatar
sds committed
171
           (make-hash-table :test #'eq))
pfdietz's avatar
pfdietz committed
172 173 174 175
  t)

(deftest equalp.23
  (equalpt (make-hash-table :test 'eql)
sds's avatar
sds committed
176
           (make-hash-table :test #'eql))
pfdietz's avatar
pfdietz committed
177 178 179 180
  t)

(deftest equalp.24
  (equalpt (make-hash-table :test 'equal)
sds's avatar
sds committed
181
           (make-hash-table :test #'equal))
pfdietz's avatar
pfdietz committed
182 183 184 185
  t)

(deftest equalp.25
  (equalpt (make-hash-table :test 'equalp)
sds's avatar
sds committed
186
           (make-hash-table :test #'equalp))
pfdietz's avatar
pfdietz committed
187 188 189 190
  t)

(deftest equalp.26
  (let ((ht1 (make-hash-table :test #'eq))
sds's avatar
sds committed
191
        (ht2 (make-hash-table :test #'eq)))
pfdietz's avatar
pfdietz committed
192 193 194 195 196 197 198
    (setf (gethash #\a ht1) t)
    (setf (gethash #\A ht2) t)
    (equalpt ht1 ht2))
  nil)

(deftest equalp.27
  (let ((ht1 (make-hash-table :test #'eq))
sds's avatar
sds committed
199
        (ht2 (make-hash-table :test #'eq)))
pfdietz's avatar
pfdietz committed
200 201 202 203 204 205 206
    (setf (gethash 'a ht1) #\a)
    (setf (gethash 'a ht2) #\A)
    (equalpt ht1 ht2))
  t)

(deftest equalp.28
  (let ((ht1 (make-hash-table :test #'eql))
sds's avatar
sds committed
207
        (ht2 (make-hash-table :test #'eql)))
pfdietz's avatar
pfdietz committed
208 209 210 211 212 213 214
    (setf (gethash #\a ht1) t)
    (setf (gethash #\A ht2) t)
    (equalpt ht1 ht2))
  nil)

(deftest equalp.29
  (let ((ht1 (make-hash-table :test #'eql))
sds's avatar
sds committed
215
        (ht2 (make-hash-table :test #'eql)))
pfdietz's avatar
pfdietz committed
216 217 218 219 220
    (setf (gethash #\a ht1) "a")
    (setf (gethash #\a ht2) "A")
    (equalpt ht1 ht2))
  t)

pfdietz's avatar
pfdietz committed
221 222
(deftest equalp.30
  (let ((ht1 (make-hash-table :test #'equal))
sds's avatar
sds committed
223
        (ht2 (make-hash-table :test #'equal)))
pfdietz's avatar
pfdietz committed
224 225 226 227 228 229 230
    (setf (gethash #\a ht1) t)
    (setf (gethash #\A ht2) t)
    (equalpt ht1 ht2))
  nil)

(deftest equalp.31
  (let ((ht1 (make-hash-table :test #'equal))
sds's avatar
sds committed
231
        (ht2 (make-hash-table :test #'equal)))
pfdietz's avatar
pfdietz committed
232 233 234 235 236 237 238
    (setf (gethash #\a ht1) "a")
    (setf (gethash #\a ht2) "A")
    (equalpt ht1 ht2))
  t)

(deftest equalp.32
  (let ((ht1 (make-hash-table :test #'equalp))
sds's avatar
sds committed
239
        (ht2 (make-hash-table :test #'equalp)))
pfdietz's avatar
pfdietz committed
240 241 242 243 244 245 246
    (setf (gethash #\a ht1) t)
    (setf (gethash #\A ht2) t)
    (equalpt ht1 ht2))
  t)

(deftest equalp.33
  (let ((ht1 (make-hash-table :test #'equalp))
sds's avatar
sds committed
247
        (ht2 (make-hash-table :test #'equalp)))
pfdietz's avatar
pfdietz committed
248 249 250 251 252 253 254
    (setf (gethash #\a ht1) "a")
    (setf (gethash #\a ht2) "A")
    (equalpt ht1 ht2))
  t)

(deftest equalp.34
  (let ((ht1 (make-hash-table :test #'equalp))
sds's avatar
sds committed
255
        (ht2 (make-hash-table :test #'equalp)))
pfdietz's avatar
pfdietz committed
256 257 258 259 260 261 262
    (setf (gethash '#:a ht1) t)
    (setf (gethash '#:a ht2) t)
    (equalpt ht1 ht2))
  nil)

(deftest equalp.35
  (loop for test in '(eq eql equal equalp)
sds's avatar
sds committed
263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282
        collect
        (flet ((%make-table
                ()
                (apply #'make-hash-table
                       :test test
                       `(,@(when (coin)
                             (list :size (random 100)))
                           ,@(when (coin)
                               (list :rehash-size (1+ (random 50))))
                           ,@(when (coin)
                               (list :rehash-threshold (random 1.0)) )))))
          (loop repeat 200
                count
                (let ((ht1 (%make-table))
                      (ht2 (%make-table))
                      (pairs (loop for i below (random 100) collect (cons (gensym) i))))
                  (loop for (k . v) in pairs do (setf (gethash k ht1) v))
                  (setf pairs (random-permute pairs))
                  (loop for (k . v) in pairs do (setf (gethash k ht2) v))
                  (not (equalp ht1 ht2))))))
pfdietz's avatar
pfdietz committed
283 284
  (0 0 0 0))

285 286
(defclass equalp-class-36 () ((slot1 :initarg :slot1) (slot2 :initarg :slot2)))

287
;;; If structure is backed up by an instance, it may happen that
288 289 290
;;; instances are compared like structures for `equalp' - slot by
;;; slot. This was a problem in ECL 16.1.3.
(deftest equalp.36
291 292
    (equalp (make-instance 'equalp-class-36 :slot1 1 :slot2 2)
            (make-instance 'equalp-class-36 :slot1 1 :slot2 2))
293 294
  nil)

295
(deftest equalp.order.1
296 297 298 299 300 301
  (let ((i 0) x y)
    (values
     (equalp (setf x (incf i)) (setf y (incf i)))
     i x y))
  nil 2 1 2)

302 303
;;; Error tests

304
(deftest equalp.error.1
305 306
  (signals-error (equalp) program-error)
  t)
307 308

(deftest equalp.error.2
309 310
  (signals-error (equalp nil) program-error)
  t)
311 312

(deftest equalp.error.3
313 314
  (signals-error (equalp nil nil nil) program-error)
  t)