;-*- Mode: Lisp -*- ;;;; Author: Paul Dietz ;;;; Created: Thu Oct 17 22:14:42 2002 ;;;; Contains: Tests for EQUALP (deftest equalp.1 (loop for c across +base-chars+ always (loop for d across +base-chars+ always (if (char-equal c d) (equalpt c d) (not (equalpt c d))))) t) (deftest equalp.2 (loop for i from 1 to 100 always (loop for j from 1 to 100 always (if (eqlt i j) (equalpt i j) (not (equalpt i j))))) t) (deftest equalp.3 (equalpt "abc" "ABC") t) (deftest equalp.4 (equalpt "abc" "abd") nil) (deftest equalp.5 :notes (:allow-nil-arrays) (equalpt (make-array '(0) :element-type nil) #()) t) (deftest equalp.6 :notes (:allow-nil-arrays) (equalpt (make-array '(0) :element-type nil) "") t) (deftest equalp.7 (loop for nbits from 1 to 100 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)) nil) (deftest equalp.8 (loop for nbits from 1 to 100 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)) nil) (deftest equalp.9 (loop for nbits from 1 to 100 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)) nil) (deftest equalp.10 (equalpt #*0010 #(0 0 1 0)) t) (deftest equalp.11 (let ((v1 #(1 2 3)) (v2 (make-array 8 :initial-contents '(1 2 3 4 5 6 7 8) :fill-pointer 3))) (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) :element-type 'base-char)) (s2 (make-array '(4) :initial-contents '(#\a #\b #\c #\d) :element-type 'character))) (equalpt s1 s2)) t) (deftest equalp.15 (let ((bv (make-array '(4) :initial-contents '(0 0 1 0) :element-type 'bit)) (v #(0 0 1 0))) (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)) (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))) (values (equalpt s1 s2) (equalpt s1 s3) (equalpt s2 s3))) t nil nil) (deftest equalp.17 (loop for i below 8192 for f = (float i 1.0s0) repeat 1000 unless (equalp i f) collect (list i f)) nil) (deftest equalp.18 (loop for i = (- (random 10000000) 5000000) for f = (float i 1.0f0) repeat 1000 unless (equalp i f) collect (list i f)) nil) (deftest equalp.19 (loop for i = (- (random 10000000) 5000000) for f = (float i 1.0d0) repeat 1000 unless (equalp i f) collect (list i f)) nil) (deftest equalp.20 (loop for i = (- (random 10000000) 5000000) for f = (float i 1.0l0) repeat 1000 unless (equalp i f) collect (list i f)) nil) (deftest equalp.21 (let ((ht1 (make-hash-table :test #'eq)) (ht2 (make-hash-table :test #'eql)) (ht3 (make-hash-table :test #'equal)) (ht4 (make-hash-table :test #'equalp))) (values (equalpt ht1 ht2) (equalpt ht1 ht3) (equalpt ht1 ht4) (equalpt ht2 ht3) (equalpt ht2 ht4) (equalpt ht3 ht4))) nil nil nil nil nil nil) (deftest equalp.22 (equalpt (make-hash-table :test 'eq) (make-hash-table :test #'eq)) t) (deftest equalp.23 (equalpt (make-hash-table :test 'eql) (make-hash-table :test #'eql)) t) (deftest equalp.24 (equalpt (make-hash-table :test 'equal) (make-hash-table :test #'equal)) t) (deftest equalp.25 (equalpt (make-hash-table :test 'equalp) (make-hash-table :test #'equalp)) t) (deftest equalp.26 (let ((ht1 (make-hash-table :test #'eq)) (ht2 (make-hash-table :test #'eq))) (setf (gethash #\a ht1) t) (setf (gethash #\A ht2) t) (equalpt ht1 ht2)) nil) (deftest equalp.27 (let ((ht1 (make-hash-table :test #'eq)) (ht2 (make-hash-table :test #'eq))) (setf (gethash 'a ht1) #\a) (setf (gethash 'a ht2) #\A) (equalpt ht1 ht2)) t) (deftest equalp.28 (let ((ht1 (make-hash-table :test #'eql)) (ht2 (make-hash-table :test #'eql))) (setf (gethash #\a ht1) t) (setf (gethash #\A ht2) t) (equalpt ht1 ht2)) nil) (deftest equalp.29 (let ((ht1 (make-hash-table :test #'eql)) (ht2 (make-hash-table :test #'eql))) (setf (gethash #\a ht1) "a") (setf (gethash #\a ht2) "A") (equalpt ht1 ht2)) t) (deftest equalp.30 (let ((ht1 (make-hash-table :test #'equal)) (ht2 (make-hash-table :test #'equal))) (setf (gethash #\a ht1) t) (setf (gethash #\A ht2) t) (equalpt ht1 ht2)) nil) (deftest equalp.31 (let ((ht1 (make-hash-table :test #'equal)) (ht2 (make-hash-table :test #'equal))) (setf (gethash #\a ht1) "a") (setf (gethash #\a ht2) "A") (equalpt ht1 ht2)) t) (deftest equalp.32 (let ((ht1 (make-hash-table :test #'equalp)) (ht2 (make-hash-table :test #'equalp))) (setf (gethash #\a ht1) t) (setf (gethash #\A ht2) t) (equalpt ht1 ht2)) t) (deftest equalp.33 (let ((ht1 (make-hash-table :test #'equalp)) (ht2 (make-hash-table :test #'equalp))) (setf (gethash #\a ht1) "a") (setf (gethash #\a ht2) "A") (equalpt ht1 ht2)) t) (deftest equalp.34 (let ((ht1 (make-hash-table :test #'equalp)) (ht2 (make-hash-table :test #'equalp))) (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) 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)))))) (0 0 0 0)) (defclass equalp-class-36 () ((slot1 :initarg :slot1) (slot2 :initarg :slot2))) ;;; If structure is backed up by an instance, it may happen that ;;; instances are compared like structures for `equalp' - slot by ;;; slot. This was a problem in ECL 16.1.3. (deftest equalp.36 (equalp (make-instance 'equalp-class-36 :slot1 1 :slot2 2) (make-instance 'equalp-class-36 :slot1 1 :slot2 2)) nil) (deftest equalp.order.1 (let ((i 0) x y) (values (equalp (setf x (incf i)) (setf y (incf i))) i x y)) nil 2 1 2) ;;; Error tests (deftest equalp.error.1 (signals-error (equalp) program-error) t) (deftest equalp.error.2 (signals-error (equalp nil) program-error) t) (deftest equalp.error.3 (signals-error (equalp nil nil nil) program-error) t)