Commit 47ed47e6 authored by pfdietz's avatar pfdietz

Add 'harmlessness' checks for simultaneous use of :test and :test-not in forms...

Add 'harmlessness' checks for simultaneous use of :test and :test-not in forms that take these arguments.
parent 87dd8f60
......@@ -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))
......
......@@ -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))
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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")
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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))
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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)
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment