From 47ed47e6bc973101e3a67a36a6455172d711f258 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Mon, 16 Jun 2003 11:38:15 +0000 Subject: [PATCH] Add 'harmlessness' checks for simultaneous use of :test and :test-not in forms that take these arguments. --- ansi-tests/adjoin.lsp | 7 ++++- ansi-tests/ansi-aux.lsp | 13 ++++++++ ansi-tests/assoc.lsp | 8 +++++ ansi-tests/count.lsp | 24 +++++++++++++++ ansi-tests/find.lsp | 26 ++++++++++++++++ ansi-tests/intersection.lsp | 6 ++++ ansi-tests/load-cons.lsp | 2 +- ansi-tests/member.lsp | 6 ++++ ansi-tests/mismatch.lsp | 26 ++++++++++++++++ ansi-tests/nintersection.lsp | 6 ++++ ansi-tests/nset-difference.lsp | 6 ++++ ansi-tests/nset-exclusive-or.lsp | 8 +++++ ansi-tests/nsublis.lsp | 8 +++++ ansi-tests/nsubst.lsp | 6 ++++ ansi-tests/nsubstitute.lsp | 25 +++++++++++++++ ansi-tests/nunion.lsp | 4 +++ ansi-tests/position.lsp | 24 +++++++++++++++ ansi-tests/pushnew.lsp | 7 +++++ ansi-tests/rassoc.lsp | 6 ++++ ansi-tests/remove-duplicates.lsp | 16 ++++++++++ ansi-tests/remove.lsp | 52 ++++++++++++++++++++++++++++++++ ansi-tests/search-list.lsp | 28 +++++++++++++++-- ansi-tests/set-difference.lsp | 6 ++++ ansi-tests/set-exclusive-or.lsp | 9 ++++++ ansi-tests/sublis.lsp | 8 +++++ ansi-tests/subsetp.lsp | 6 ++++ ansi-tests/subst.lsp | 7 +++++ ansi-tests/substitute.lsp | 25 +++++++++++++++ ansi-tests/tree-equal.lsp | 25 +++++++++++---- ansi-tests/union.lsp | 7 +++++ 30 files changed, 397 insertions(+), 10 deletions(-) diff --git a/ansi-tests/adjoin.lsp b/ansi-tests/adjoin.lsp index 6d3ae5ac..943c100b 100644 --- a/ansi-tests/adjoin.lsp +++ b/ansi-tests/adjoin.lsp @@ -102,6 +102,11 @@ (adjoin 10 '(1 2 3) :test-not #'<) (1 2 3)) +(defharmless adjoin.test-and-test-not.1 + (adjoin 'a '(b c) :test #'eql :test-not #'eql)) + +(defharmless adjoin.test-and-test-not.2 + (adjoin 'a '(b c) :test-not #'eql :test #'eql)) (deftest adjoin.order.1 (let ((i 0) w x y z) @@ -148,7 +153,7 @@ (deftest adjoin.repeat-key (adjoin 'a '(b c) :test #'eq :test (complement #'eq)) - (a b c)) + (a b c)) (deftest adjoin.error.1 (classify-error (adjoin)) diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp index 8a2a3300..ba808932 100644 --- a/ansi-tests/ansi-aux.lsp +++ b/ansi-tests/ansi-aux.lsp @@ -1476,3 +1476,16 @@ the condition to go uncaught if it cannot be classified." ;;; (when (typep (find-class 'standard-class) 'standard-class) ;;; (defclass substandard-class (standard-class) ()) ;;; (defparameter *can-define-metaclasses* t)) + +;;; Macro for testing that something is undefined but 'harmless' + +(defmacro defharmless (name form) + `(deftest ,name + (block done + (let ((*debugger-hook* #'(lambda (&rest args) + (declare (ignore args)) + (return-from done :good)))) + (handler-case + (unwind-protect (eval ',form) (return-from done :good)) + (condition () :good)))) + :good)) diff --git a/ansi-tests/assoc.lsp b/ansi-tests/assoc.lsp index c72fd354..3b296c76 100644 --- a/ansi-tests/assoc.lsp +++ b/ansi-tests/assoc.lsp @@ -150,6 +150,14 @@ (assoc 10 '((1 a) (5 b) (8 c) (11 d) (12 e)) :test-not #'>=) (11 d)) +;;; :test & :test-not together are harmless + +(defharmless assoc.test-and-test-not.1 + (assoc 'a '((a . 1) (b . 2)) :test #'eql :test-not #'eql)) + +(defharmless assoc.test-and-test-not.2 + (assoc 'a '((a . 1) (b . 2)) :test-not #'eql :test #'eql)) + ;;; Order of argument evaluation (deftest assoc.order.1 diff --git a/ansi-tests/count.lsp b/ansi-tests/count.lsp index 057d8249..61fc1ab2 100644 --- a/ansi-tests/count.lsp +++ b/ansi-tests/count.lsp @@ -87,6 +87,12 @@ (count 10 '(1 11 2 4 14 5 18 6 7) :test-not #'>=) 3) +(defharmless count-list.test-and-test-not.1 + (count 0 '(0 1 2 0 1 2 3 0 1) :test #'eql :test-not #'eql)) + +(defharmless count-list.test-and-test-not.2 + (count 0 '(0 1 2 0 1 2 3 0 1) :test-not #'eql :test #'eql)) + ;;; On vectors (deftest count-vector.1 @@ -171,6 +177,12 @@ (count 10 #(1 11 2 4 14 5 18 6 7) :test-not #'>=) 3) +(defharmless count-vector.test-and-test-not.1 + (count 0 #(0 1 2 0 1 2 3 0 1) :test #'eql :test-not #'eql)) + +(defharmless count-vector.test-and-test-not.2 + (count 0 #(0 1 2 0 1 2 3 0 1) :test-not #'eql :test #'eql)) + ;;; Non-simple vectors (deftest count-filled-vector.1 @@ -408,6 +420,12 @@ (count 1 #*00001100100 :test-not #'>) 3) +(defharmless count-bit-vector.test-and-test-not.1 + (count 0 #*0011010101100010000 :test #'eql :test-not #'eql)) + +(defharmless count-bit-vector.test-and-test-not.2 + (count 0 #*0011010101100010000 :test-not #'eql :test #'eql)) + ;;; Tests on strings (deftest count-string.1 @@ -517,6 +535,12 @@ (count #\1 "00001100100" :test-not #'char>) 3) +(defharmless count-string.test-and-test-not.1 + (count #\0 "0011010101100010000" :test #'eql :test-not #'eql)) + +(defharmless count-string.test-and-test-not.2 + (count #\0 "0011010101100010000" :test-not #'eql :test #'eql)) + ;;; Argument order tests (deftest count.order.1 diff --git a/ansi-tests/find.lsp b/ansi-tests/find.lsp index e8652e87..b8fac5ac 100644 --- a/ansi-tests/find.lsp +++ b/ansi-tests/find.lsp @@ -781,6 +781,32 @@ (find #\k "abcdmnop" :test-not #'char>=) #\m) +;;; Test & test not + +(defharmless find-list.test-and-test-not.1 + (find 'b '(a b c) :test #'eql :test-not #'eql)) + +(defharmless find-list.test-and-test-not.2 + (find 'b '(a b c) :test-not #'eql :test #'eql)) + +(defharmless find-vector.test-and-test-not.1 + (find 'b #(a b c) :test #'eql :test-not #'eql)) + +(defharmless find-vector.test-and-test-not.2 + (find 'b #(a b c) :test-not #'eql :test #'eql)) + +(defharmless find-string.test-and-test-not.1 + (find #\b "abc" :test #'eql :test-not #'eql)) + +(defharmless find-string.test-and-test-not.2 + (find #\b "abc" :test-not #'eql :test #'eql)) + +(defharmless find-bit-string.test-and-test-not.1 + (find 0 #*110110 :test #'eql :test-not #'eql)) + +(defharmless find-bit-string.test-and-test-not.2 + (find 0 #*110110 :test-not #'eql :test #'eql)) + ;;; Keyword tests (deftest find.allow-other-keys.1 diff --git a/ansi-tests/intersection.lsp b/ansi-tests/intersection.lsp index f4354f5a..8ff92c6c 100644 --- a/ansi-tests/intersection.lsp +++ b/ansi-tests/intersection.lsp @@ -230,6 +230,12 @@ (not (eql x y)))))) (4)) +(defharmless intersection.test-and-test-not.1 + (intersection '(a b c) '(a c e) :test #'eql :test-not #'eql)) + +(defharmless intersection.test-and-test-not.2 + (intersection '(a b c) '(a c e) :test-not #'eql :test #'eql)) + ;;; Order of argument evaluation tests (deftest intersection.order.1 diff --git a/ansi-tests/load-cons.lsp b/ansi-tests/load-cons.lsp index a0bd1c17..3b522089 100644 --- a/ansi-tests/load-cons.lsp +++ b/ansi-tests/load-cons.lsp @@ -9,7 +9,6 @@ (load "rplaca.lsp") (load "rplacd.lsp") (load "copy-tree.lsp") -(load "tree-equal.lsp") (load "sublis.lsp") (load "nsublis.lsp") (load "subst.lsp") @@ -18,6 +17,7 @@ (load "nsubst.lsp") (load "nsubst-if.lsp") (load "nsubst-if-not.lsp") +(load "tree-equal.lsp") (load "copy-list.lsp") (load "list.lsp") (load "list-length.lsp") diff --git a/ansi-tests/member.lsp b/ansi-tests/member.lsp index 2a50ea25..ed855e84 100644 --- a/ansi-tests/member.lsp +++ b/ansi-tests/member.lsp @@ -146,6 +146,12 @@ (member 10 '(1 2 3 4 10 11 14 18) :test-not #'>=) (11 14 18)) +(defharmless member.test-and-test-not.1 + (member 'b '(a b c) :test #'eql :test-not #'eql)) + +(defharmless member.test-and-test-not.2 + (member 'b '(a b c) :test-not #'eql :test #'eql)) + ;;; Order of evaluation (deftest member.order.1 diff --git a/ansi-tests/mismatch.lsp b/ansi-tests/mismatch.lsp index 2f9b4c34..5aa3d3a1 100644 --- a/ansi-tests/mismatch.lsp +++ b/ansi-tests/mismatch.lsp @@ -597,6 +597,32 @@ (mismatch m a :from-end t))) (4 4 5 nil nil 6 5 6)) +;;; test and test-not tests + +(defharmless mismatch.test-and-test-not.1 + (mismatch '(1 2 3) '(1 2 4) :test #'eql :test-not #'eql)) + +(defharmless mismatch.test-and-test-not.2 + (mismatch '(1 2 3) '(1 2 4) :test-not #'eql :test #'eql)) + +(defharmless mismatch.test-and-test-not.3 + (mismatch #(1 2 3) #(1 2 4) :test #'eql :test-not #'eql)) + +(defharmless mismatch.test-and-test-not.4 + (mismatch #(1 2 3) #(1 2 4) :test-not #'eql :test #'eql)) + +(defharmless mismatch.test-and-test-not.5 + (mismatch "abc" "abd" :test #'eql :test-not #'eql)) + +(defharmless mismatch.test-and-test-not.6 + (mismatch "abc" "abd" :test-not #'eql :test #'eql)) + +(defharmless mismatch.test-and-test-not.7 + (mismatch #*011 #*010 :test #'eql :test-not #'eql)) + +(defharmless mismatch.test-and-test-not.8 + (mismatch #*011 #*010 :test-not #'eql :test #'eql)) + ;;; Keyword tests (deftest mismatch.allow-other-keys.1 diff --git a/ansi-tests/nintersection.lsp b/ansi-tests/nintersection.lsp index d1f7425c..7bd18284 100644 --- a/ansi-tests/nintersection.lsp +++ b/ansi-tests/nintersection.lsp @@ -194,6 +194,12 @@ (not (eql x y)))))) (4)) +(defharmless nintersection.test-and-test-not.1 + (nintersection (list 'a 'b 'c) (list 'a 'c 'e) :test #'eql :test-not #'eql)) + +(defharmless nintersection.test-and-test-not.2 + (nintersection (list 'a 'b 'c) (list 'a 'c 'e) :test-not #'eql :test #'eql)) + ;;; Order of argument evaluation tests (deftest nintersection.order.1 diff --git a/ansi-tests/nset-difference.lsp b/ansi-tests/nset-difference.lsp index 2250bf56..26fd8e8c 100644 --- a/ansi-tests/nset-difference.lsp +++ b/ansi-tests/nset-difference.lsp @@ -143,6 +143,12 @@ #'<)) (1 2 3 4)) +(defharmless nset-difference.test-and-test-not.1 + (nset-difference (list 1 2 3 4) (list 1 7 3 8) :test #'eql :test-not #'eql)) + +(defharmless nset-difference.test-and-test-not.2 + (nset-difference (list 1 2 3 4) (list 1 7 3 8) :test-not #'eql :test #'eql)) + ;;; Order of argument evaluation tests (deftest nset-difference.order.1 diff --git a/ansi-tests/nset-exclusive-or.lsp b/ansi-tests/nset-exclusive-or.lsp index 465a1234..ca06683b 100644 --- a/ansi-tests/nset-exclusive-or.lsp +++ b/ansi-tests/nset-exclusive-or.lsp @@ -166,6 +166,14 @@ t))))) t) +(defharmless nset-exclusive-or.test-and-test-not.1 + (nset-exclusive-or (list 1 2 3 4) (list 1 7 3 8) + :test #'eql :test-not #'eql)) + +(defharmless nset-exclusive-or.test-and-test-not.2 + (nset-exclusive-or (list 1 2 3 4) (list 1 7 3 8) + :test-not #'eql :test #'eql)) + ;;; Order of argument evaluation tests (deftest nset-exclusive-or.order.1 diff --git a/ansi-tests/nsublis.lsp b/ansi-tests/nsublis.lsp index d6c15a01..9857c713 100644 --- a/ansi-tests/nsublis.lsp +++ b/ansi-tests/nsublis.lsp @@ -80,6 +80,14 @@ #'(lambda (x y) (not (and (realp x) (realp y) (< x y))))) (x y z 20)) +(defharmless nsublis.test-and-test-not.1 + (nsublis '((a . 1) (b . 2)) (list 'a 'b 'c 'd) + :test #'eql :test-not #'eql)) + +(defharmless nsublis.test-and-test-not.2 + (nsublis '((a . 1) (b . 2)) (list 'a 'b 'c 'd) + :test-not #'eql :test #'eql)) + ;;; Order of argument evaluation (deftest nsublis.order.1 (let ((i 0) w x y z) diff --git a/ansi-tests/nsubst.lsp b/ansi-tests/nsubst.lsp index 14436fa2..f025d923 100644 --- a/ansi-tests/nsubst.lsp +++ b/ansi-tests/nsubst.lsp @@ -73,6 +73,12 @@ (not (and (realp x) (realp y) (< x y))))) (1 2 10 x x 4)) +(defharmless nsubset.test-and-test-not.1 + (nsubst 'a 'b (list 'a 'b 'c 'd 'e) :test #'eq :test-not #'eq)) + +(defharmless nsubset.test-and-test-not.2 + (nsubst 'a 'b (list 'a 'b 'c 'd 'e) :test-not #'eq :test #'eq)) + ;;; Order of argument evaluation (deftest nsubst.order.1 (let ((i 0) v w x y z) diff --git a/ansi-tests/nsubstitute.lsp b/ansi-tests/nsubstitute.lsp index ea6a6b0d..c3f808fc 100644 --- a/ansi-tests/nsubstitute.lsp +++ b/ansi-tests/nsubstitute.lsp @@ -722,6 +722,31 @@ result) #*0101011111) +(defharmless nsubstitute.test-and-test-not.1 + (nsubstitute 'b 'a (list 'a 'b 'c 'd 'a 'b) :test #'eql :test-not #'eql)) + +(defharmless nsubstitute.test-and-test-not.2 + (nsubstitute 'b 'a (list 'a 'b 'c 'd 'a 'b) :test-not #'eql :test #'eql)) + +(defharmless nsubstitute.test-and-test-not.3 + (nsubstitute 'b 'a (vector 'a 'b 'c 'd 'a 'b) :test #'eql :test-not #'eql)) + +(defharmless nsubstitute.test-and-test-not.4 + (nsubstitute 'b 'a (vector 'a 'b 'c 'd 'a 'b) :test-not #'eql :test #'eql)) + +(defharmless nsubstitute.test-and-test-not.5 + (nsubstitute #\b #\a (copy-seq "abcdab") :test #'eql :test-not #'eql)) + +(defharmless nsubstitute.test-and-test-not.6 + (nsubstitute #\b #\a (copy-seq "abcdab") :test-not #'eql :test #'eql)) + +(defharmless nsubstitute.test-and-test-not.7 + (nsubstitute 1 0 (copy-seq #*001101001) :test #'eql :test-not #'eql)) + +(defharmless nsubstitute.test-and-test-not.8 + (nsubstitute 0 1 (copy-seq #*1100110101) :test-not #'eql :test #'eql)) + + ;;;; additional tests (deftest nsubstitute-list.24 diff --git a/ansi-tests/nunion.lsp b/ansi-tests/nunion.lsp index 496b2a45..9f550b2f 100644 --- a/ansi-tests/nunion.lsp +++ b/ansi-tests/nunion.lsp @@ -203,7 +203,11 @@ (list (copy-seq "aa"))) ("aa" "aa")) +(defharmless nunion.test-and-test-not.1 + (nunion (list 1 4 8 10) (list 1 2 3 9 10 13) :test #'eql :test-not #'eql)) +(defharmless nunion.test-and-test-not.2 + (nunion (list 1 4 8 10) (list 1 2 3 9 10 13) :test-not #'eql :test #'eql)) ;; Check that nunion does not reverse the arguments to :test, :test-not diff --git a/ansi-tests/position.lsp b/ansi-tests/position.lsp index f512d645..aa5da8e5 100644 --- a/ansi-tests/position.lsp +++ b/ansi-tests/position.lsp @@ -670,6 +670,30 @@ (position #\m "adfmpz" :test-not #'char>=) 4) +(defharmless position.test-and-test-not.1 + (position 'b '(a b c d) :test #'eql :test-not #'eql)) + +(defharmless position.test-and-test-not.2 + (position 'b '(a b c d) :test-not #'eql :test #'eql)) + +(defharmless position.test-and-test-not.3 + (position 'b #(a b c d) :test #'eql :test-not #'eql)) + +(defharmless position.test-and-test-not.4 + (position 'b #(a b c d) :test-not #'eql :test #'eql)) + +(defharmless position.test-and-test-not.5 + (position #\b "abcd" :test #'eql :test-not #'eql)) + +(defharmless position.test-and-test-not.6 + (position #\b "abcd" :test-not #'eql :test #'eql)) + +(defharmless position.test-and-test-not.7 + (position 1 #*001010010 :test #'eql :test-not #'eql)) + +(defharmless position.test-and-test-not.8 + (position 0 #*1110010110111 :test-not #'eql :test #'eql)) + (deftest position.order.1 (let ((i 0) a b c d e f g) (values diff --git a/ansi-tests/pushnew.lsp b/ansi-tests/pushnew.lsp index e82216f5..5dab7061 100644 --- a/ansi-tests/pushnew.lsp +++ b/ansi-tests/pushnew.lsp @@ -185,6 +185,13 @@ (1 2 3) (1 2 3)) +(defharmless pushnew.test-and-test-not.1 + (let ((x '(b c))) (pushnew 'a x :test #'eql :test-not #'eql))) + +(defharmless pushnew.test-and-test-not.2 + (let ((x '(b c))) (pushnew 'a x :test-not #'eql :test #'eql))) + + (deftest pushnew.order.1 (let ((x (vector nil nil nil nil)) (y (vector 'a 'b 'c 'd)) diff --git a/ansi-tests/rassoc.lsp b/ansi-tests/rassoc.lsp index 9a8f4916..2d829882 100644 --- a/ansi-tests/rassoc.lsp +++ b/ansi-tests/rassoc.lsp @@ -188,6 +188,12 @@ :test-not #'>=) (d . 15)) +(defharmless rassoc.test-and-test-not.1 + (rassoc 'a '((x . b) (y . a) (z . c)) :test #'eql :test-not #'eql)) + +(defharmless rassoc.test-and-test-not.2 + (rassoc 'a '((x . b) (y . a) (z . c)) :test-not #'eql :test #'eql)) + ;;; Order of argument evaluation (deftest rassoc.order.1 diff --git a/ansi-tests/remove-duplicates.lsp b/ansi-tests/remove-duplicates.lsp index ac5956b9..e17adf53 100644 --- a/ansi-tests/remove-duplicates.lsp +++ b/ansi-tests/remove-duplicates.lsp @@ -31,6 +31,22 @@ y) (3 4 1 5 6 2 7)) +(defharmless remove-duplicates.test-and-test-not.1 + (remove-duplicates (list 'a 'b 'c 'd 'a 'e 'f 'd 'g) :test #'eql + :test-not #'eql)) + +(defharmless remove-duplicates.test-and-test-not.2 + (remove-duplicates (list 'a 'b 'c 'd 'a 'e 'f 'd 'g) :test-not #'eql + :test #'eql)) + +(defharmless delete-duplicates.test-and-test-not.1 + (delete-duplicates (list 'a 'b 'c 'd 'a 'e 'f 'd 'g) :test #'eql + :test-not #'eql)) + +(defharmless delete-duplicates.test-and-test-not.2 + (delete-duplicates (list 'a 'b 'c 'd 'a 'e 'f 'd 'g) :test-not #'eql + :test #'eql)) + ;;; Order of evaluation tests diff --git a/ansi-tests/remove.lsp b/ansi-tests/remove.lsp index ecb01279..09450025 100644 --- a/ansi-tests/remove.lsp +++ b/ansi-tests/remove.lsp @@ -366,6 +366,58 @@ (delete 0 (copy-seq #*11111) :count -1) #*11111) +;;; test & test-not together is harmless + +(defharmless remove-list.test-and-test-not.1 + (remove 'a '(a b c) :test #'eql :test-not #'eql)) + +(defharmless remove-list.test-and-test-not.2 + (remove 'a '(a b c) :test-not #'eql :test #'eql)) + +(defharmless remove-vector.test-and-test-not.1 + (remove 'a #(a b c) :test #'eql :test-not #'eql)) + +(defharmless remove-vector.test-and-test-not.2 + (remove 'a #(a b c) :test-not #'eql :test #'eql)) + +(defharmless remove-bit-string.test-and-test-not.1 + (remove 0 #*0001100100 :test #'eql :test-not #'eql)) + +(defharmless remove-bit-string.test-and-test-not.2 + (remove 0 #*0001100100 :test-not #'eql :test #'eql)) + +(defharmless remove-string.test-and-test-not.1 + (remove #\0 "0001100100" :test #'eql :test-not #'eql)) + +(defharmless remove-string.test-and-test-not.2 + (remove #\0 "0001100100" :test-not #'eql :test #'eql)) + + +(defharmless delete-list.test-and-test-not.1 + (delete 'a (list 'a 'b 'c) :test #'eql :test-not #'eql)) + +(defharmless delete-list.test-and-test-not.2 + (delete 'a (list 'a 'b 'c) :test-not #'eql :test #'eql)) + +(defharmless delete-vector.test-and-test-not.1 + (delete 'a (vector 'a 'b 'c) :test #'eql :test-not #'eql)) + +(defharmless delete-vector.test-and-test-not.2 + (delete 'a (vector 'a 'b 'c) :test-not #'eql :test #'eql)) + +(defharmless delete-bit-string.test-and-test-not.1 + (delete 0 (copy-seq #*0001100100) :test #'eql :test-not #'eql)) + +(defharmless delete-bit-string.test-and-test-not.2 + (delete 0 (copy-seq #*0001100100) :test-not #'eql :test #'eql)) + +(defharmless delete-string.test-and-test-not.1 + (delete #\0 (copy-seq "0001100100") :test #'eql :test-not #'eql)) + +(defharmless delete-string.test-and-test-not.2 + (delete #\0 (copy-seq "0001100100") :test-not #'eql :test #'eql)) + + ;;; Order of evaluation tests (deftest remove.order.1 diff --git a/ansi-tests/search-list.lsp b/ansi-tests/search-list.lsp index 69f4b205..2d205a84 100644 --- a/ansi-tests/search-list.lsp +++ b/ansi-tests/search-list.lsp @@ -139,15 +139,39 @@ (deftest search-list.15 (let ((pat '(10)) (target '(1 4 6 10 15 20))) - (search pat target :test #'<)) + (search pat target :test #'>)) 4) (deftest search-list.16 (let ((pat '(10)) (target '(1 4 6 10 15 20))) - (search pat target :test-not #'>=)) + (search pat target :test-not #'<=)) 4) +(defharmless search.test-and-test-not.1 + (search '(b c) '(a b c d) :test #'eql :test-not #'eql)) + +(defharmless search.test-and-test-not.2 + (search '(b c) '(a b c d) :test-not #'eql :test #'eql)) + +(defharmless search.test-and-test-not.3 + (search #(b c) #(a b c d) :test #'eql :test-not #'eql)) + +(defharmless search.test-and-test-not.4 + (search #(b c) #(a b c d) :test-not #'eql :test #'eql)) + +(defharmless search.test-and-test-not.5 + (search "bc" "abcd" :test #'eql :test-not #'eql)) + +(defharmless search.test-and-test-not.6 + (search "bc" "abcd" :test-not #'eql :test #'eql)) + +(defharmless search.test-and-test-not.7 + (search #*01 #*0011 :test #'eql :test-not #'eql)) + +(defharmless search.test-and-test-not.8 + (search #*01 #*0011 :test-not #'eql :test #'eql)) + ;;; Keyword tests diff --git a/ansi-tests/set-difference.lsp b/ansi-tests/set-difference.lsp index 356fbde9..e1aff9e4 100644 --- a/ansi-tests/set-difference.lsp +++ b/ansi-tests/set-difference.lsp @@ -144,6 +144,12 @@ #'<)) (1 2 3 4)) +(defharmless set-difference.test-and-test-not.1 + (set-difference (list 1 2 3 4) (list 1 7 3 8) :test #'eql :test-not #'eql)) + +(defharmless set-difference.test-and-test-not.2 + (set-difference (list 1 2 3 4) (list 1 7 3 8) :test-not #'eql :test #'eql)) + ;;; Order of argument evaluation tests (deftest set-difference.order.1 diff --git a/ansi-tests/set-exclusive-or.lsp b/ansi-tests/set-exclusive-or.lsp index 78b3a2bd..7464677e 100644 --- a/ansi-tests/set-exclusive-or.lsp +++ b/ansi-tests/set-exclusive-or.lsp @@ -166,6 +166,15 @@ t))))) t) +(defharmless set-exclusive-or.test-and-test-not.1 + (set-exclusive-or (list 1 2 3 4) (list 1 7 3 8) + :test #'eql :test-not #'eql)) + +(defharmless set-exclusive-or.test-and-test-not.2 + (set-exclusive-or (list 1 2 3 4) (list 1 7 3 8) + :test-not #'eql :test #'eql)) + + ;;; Order of argument evaluation tests (deftest set-exclusive-or.order.1 diff --git a/ansi-tests/sublis.lsp b/ansi-tests/sublis.lsp index 5b508a52..8740d05d 100644 --- a/ansi-tests/sublis.lsp +++ b/ansi-tests/sublis.lsp @@ -76,6 +76,14 @@ #'(lambda (x y) (not (and (realp x) (realp y) (< x y))))) (x y z 20)) +(defharmless sublis.test-and-test-not.1 + (sublis '((a . 1) (b . 2)) (list 'a 'b 'c 'd) + :test #'eql :test-not #'eql)) + +(defharmless sublis.test-and-test-not.2 + (sublis '((a . 1) (b . 2)) (list 'a 'b 'c 'd) + :test-not #'eql :test #'eql)) + ;;; Order of argument evaluation (deftest sublis.order.1 (let ((i 0) w x y z) diff --git a/ansi-tests/subsetp.lsp b/ansi-tests/subsetp.lsp index 450490ea..ae2fd11f 100644 --- a/ansi-tests/subsetp.lsp +++ b/ansi-tests/subsetp.lsp @@ -121,6 +121,12 @@ nil))) t) +(defharmless subsetp.test-and-test-not.1 + (subsetp '(a b c) '(a g c e b) :test #'eql :test-not #'eql)) + +(defharmless subsetp.test-and-test-not.3 + (subsetp '(a b c) '(a g c e b) :test-not #'eql :test #'eql)) + ;;; Order of argument evaluation tests (deftest subsetp.order.1 diff --git a/ansi-tests/subst.lsp b/ansi-tests/subst.lsp index de9c877f..41389609 100644 --- a/ansi-tests/subst.lsp +++ b/ansi-tests/subst.lsp @@ -72,6 +72,13 @@ (not (and (realp x) (realp y) (< x y))))) (1 2 10 x x 4)) +(defharmless subset.test-and-test-not.1 + (subst 'a 'b (list 'a 'b 'c 'd 'e) :test #'eq :test-not #'eq)) + +(defharmless subset.test-and-test-not.2 + (subst 'a 'b (list 'a 'b 'c 'd 'e) :test-not #'eq :test #'eq)) + + ;;; Order of argument evaluation (deftest subst.order.1 (let ((i 0) v w x y z) diff --git a/ansi-tests/substitute.lsp b/ansi-tests/substitute.lsp index bd17f8e5..201f0249 100644 --- a/ansi-tests/substitute.lsp +++ b/ansi-tests/substitute.lsp @@ -966,6 +966,31 @@ result) #*01111) +(defharmless substitute.test-and-test-not.1 + (substitute 'b 'a (list 'a 'b 'c 'd 'a 'b) :test #'eql :test-not #'eql)) + +(defharmless substitute.test-and-test-not.2 + (substitute 'b 'a (list 'a 'b 'c 'd 'a 'b) :test-not #'eql :test #'eql)) + +(defharmless substitute.test-and-test-not.3 + (substitute 'b 'a (vector 'a 'b 'c 'd 'a 'b) :test #'eql :test-not #'eql)) + +(defharmless substitute.test-and-test-not.4 + (substitute 'b 'a (vector 'a 'b 'c 'd 'a 'b) :test-not #'eql :test #'eql)) + +(defharmless substitute.test-and-test-not.5 + (substitute #\b #\a (copy-seq "abcdab") :test #'eql :test-not #'eql)) + +(defharmless substitute.test-and-test-not.6 + (substitute #\b #\a (copy-seq "abcdab") :test-not #'eql :test #'eql)) + +(defharmless substitute.test-and-test-not.7 + (substitute 1 0 (copy-seq #*001101001) :test #'eql :test-not #'eql)) + +(defharmless substitute.test-and-test-not.8 + (substitute 0 1 (copy-seq #*1100110101) :test-not #'eql :test #'eql)) + + (deftest substitute.order.1 (let ((i 0) a b c d e f g h) (values diff --git a/ansi-tests/tree-equal.lsp b/ansi-tests/tree-equal.lsp index c9bb3aaa..73d9c841 100644 --- a/ansi-tests/tree-equal.lsp +++ b/ansi-tests/tree-equal.lsp @@ -79,6 +79,12 @@ (tree-equal x y)) nil) +(defharmless tree-equal.test-and-test-not.1 + (tree-equal '(a b) '(a b) :test #'eql :test-not #'eql)) + +(defharmless tree-equal.test-and-test-not.2 + (tree-equal '(a b) '(a b) :test-not #'eql :test #'eql)) + ;;; Keywords tests (deftest tree-equal.allow-other-keys.1 @@ -98,6 +104,13 @@ :allow-other-keys nil :foo t)) t) +(deftest tree-equal.keywords.1 + (notnot-mv (tree-equal '(a . b) '(b . a) + :test (complement #'eql) + :test #'eql)) + t) + + ;;; Error tests (deftest tree-equal.error.1 @@ -116,10 +129,10 @@ (classify-error (tree-equal '(a b) '(a b) (gensym) t :allow-other-keys nil)) program-error) +(deftest tree-equal.error.5 + (classify-error (tree-equal '(a b) '(a b) :test #'identity)) + program-error) - - - - - - \ No newline at end of file +(deftest tree-equal.error.6 + (classify-error (tree-equal '(a b) '(a b) :test #'(lambda (x y z) (eq x y)))) + program-error) diff --git a/ansi-tests/union.lsp b/ansi-tests/union.lsp index 4e84766c..200030d8 100644 --- a/ansi-tests/union.lsp +++ b/ansi-tests/union.lsp @@ -259,6 +259,13 @@ #'<)) (1 2 3 4 5 6)) +(defharmless union.test-and-test-not.1 + (union (list 1 4 8 10) (list 1 2 3 9 10 13) :test #'eql :test-not #'eql)) + +(defharmless union.test-and-test-not.2 + (union (list 1 4 8 10) (list 1 2 3 9 10 13) :test-not #'eql :test #'eql)) + + ;;; Order of evaluation tests (deftest union.order.1 -- GitLab