diff --git a/ansi-tests/adjoin.lsp b/ansi-tests/adjoin.lsp index 9e000fce22e14992cf1f27b6a1798c79ab5bc272..6d3ae5ac32687c8cd3f2974a49cf18bcec47fec0 100644 --- a/ansi-tests/adjoin.lsp +++ b/ansi-tests/adjoin.lsp @@ -84,6 +84,25 @@ :test-not (complement #'equal) :key nil) (aaa "AAA" "aaa" #\a)) +;;; Ordering in comparison function + +(deftest adjoin.19 + (adjoin 10 '(1 2 3) :test #'<) + (10 1 2 3)) + +(deftest adjoin.20 + (adjoin 10 '(1 2 3) :test #'>) + (1 2 3)) + +(deftest adjoin.21 + (adjoin 10 '(1 2 3) :test-not #'>) + (10 1 2 3)) + +(deftest adjoin.22 + (adjoin 10 '(1 2 3) :test-not #'<) + (1 2 3)) + + (deftest adjoin.order.1 (let ((i 0) w x y z) (values diff --git a/ansi-tests/assoc.lsp b/ansi-tests/assoc.lsp index 238084d344138c87bff01ce1850481a5cf98f24f..c72fd354241bcb4dee6e8b2524876b68547cf937 100644 --- a/ansi-tests/assoc.lsp +++ b/ansi-tests/assoc.lsp @@ -140,6 +140,16 @@ (eqt x y)))) (a . 3)) +;;; Order of test arguments + +(deftest assoc.26 + (assoc 10 '((1 a) (5 b) (8 c) (11 d) (12 e)) :test #'<) + (11 d)) + +(deftest assoc.27 + (assoc 10 '((1 a) (5 b) (8 c) (11 d) (12 e)) :test-not #'>=) + (11 d)) + ;;; Order of argument evaluation (deftest assoc.order.1 diff --git a/ansi-tests/count.lsp b/ansi-tests/count.lsp index ede89ed492348acb1b7e2918c091a90ae34c94be..057d8249f151c6ca9b099ae67aca56320d1bbe10 100644 --- a/ansi-tests/count.lsp +++ b/ansi-tests/count.lsp @@ -79,6 +79,14 @@ :test #'(lambda (x y) (declare (ignore x y)) t)) 5) +(deftest count-list.17 + (count 10 '(1 11 2 4 14 5 18 6 7) :test #'<) + 3) + +(deftest count-list.18 + (count 10 '(1 11 2 4 14 5 18 6 7) :test-not #'>=) + 3) + ;;; On vectors (deftest count-vector.1 @@ -150,11 +158,19 @@ (count 1 #(1 1 1 1 1 2 1 1) :test-not #'eql) 1) -(deftest count-vector16 +(deftest count-vector.16 (count 1 #(1 1 1 3 1 2 1 1) :start 2 :end 7 :test #'(lambda (x y) (declare (ignore x y)) t)) 5) +(deftest count-vector.17 + (count 10 #(1 11 2 4 14 5 18 6 7) :test #'<) + 3) + +(deftest count-vector.18 + (count 10 #(1 11 2 4 14 5 18 6 7) :test-not #'>=) + 3) + ;;; Non-simple vectors (deftest count-filled-vector.1 @@ -384,6 +400,13 @@ :end 4) 3) +(deftest count-bit-vector.21 + (count 1 #*00001100100 :test #'<=) + 3) + +(deftest count-bit-vector.22 + (count 1 #*00001100100 :test-not #'>) + 3) ;;; Tests on strings @@ -486,6 +509,14 @@ :start 2 :end 5) 3) +(deftest count-string.21 + (count #\1 "00001100100" :test #'char<=) + 3) + +(deftest count-string.22 + (count #\1 "00001100100" :test-not #'char>) + 3) + ;;; Argument order tests (deftest count.order.1 diff --git a/ansi-tests/find.lsp b/ansi-tests/find.lsp index c9de8b080d701283564c106d9028120434226eec..e8652e872567125fdef8a452813203f3d7351c61 100644 --- a/ansi-tests/find.lsp +++ b/ansi-tests/find.lsp @@ -150,6 +150,14 @@ :start 2 :from-end t) (a b)) +(deftest find-list.29 + (find 10 '(1 2 3 8 20 3 1 21 3) :test #'<) + 20) + +(deftest find-list.30 + (find 10 '(1 2 3 8 20 3 1 21 3) :test-not #'>=) + 20) + ;;; Tests on vectors (deftest find-vector.1 @@ -320,6 +328,14 @@ (loop for i from 1 to 5 collect (find i a :from-end t :key #'car))) ((1 1) (2 2) (3 3) (4 4) (5 5))) +(deftest find-vector.31 + (find 10 #(1 2 3 8 20 3 1 21 3) :test #'<) + 20) + +(deftest find-vector.32 + (find 10 #(1 2 3 8 20 3 1 21 3) :test-not #'>=) + 20) + ;;; tests on bit vectors (deftest find-bit-vector.1 @@ -593,6 +609,22 @@ (values (find 0 a) (find 0 a :from-end t))) 0 0) +(deftest find-bit-vector.31 + (find 2 #*00011010010 :test #'<) + nil) + +(deftest find-bit-vector.32 + (find 2 #*0010101101 :test-not #'>=) + nil) + +(deftest find-bit-vector.33 + (find 0 #*00011010010 :test #'<) + 1) + +(deftest find-bit-vector.34 + (find 0 #*0010101101 :test-not #'>=) + 1) + ;;; strings (deftest find-string.1 @@ -741,6 +773,14 @@ (#\a #\b #\c #\d #\e nil nil nil nil nil) (#\a #\b #\c #\d #\e nil nil nil nil nil)) +(deftest find-string.26 + (find #\k "abcdmnop" :test #'char<) + #\m) + +(deftest find-string.27 + (find #\k "abcdmnop" :test-not #'char>=) + #\m) + ;;; Keyword tests (deftest find.allow-other-keys.1 diff --git a/ansi-tests/load-cons.lsp b/ansi-tests/load-cons.lsp index 8a1faf741f5f3ad04bbf9427b6e2d4f58cd5cff6..a0bd1c1772637d74d1d20ce089fe39e6b530a3c0 100644 --- a/ansi-tests/load-cons.lsp +++ b/ansi-tests/load-cons.lsp @@ -9,6 +9,7 @@ (load "rplaca.lsp") (load "rplacd.lsp") (load "copy-tree.lsp") +(load "tree-equal.lsp") (load "sublis.lsp") (load "nsublis.lsp") (load "subst.lsp") diff --git a/ansi-tests/load-symbols.lsp b/ansi-tests/load-symbols.lsp index b56019c68cf21cadd58dcf3b3714c0f0226b6b2c..d8863f009a313bb7e5d9d6f7810249ce01bb2b5e 100644 --- a/ansi-tests/load-symbols.lsp +++ b/ansi-tests/load-symbols.lsp @@ -9,5 +9,3 @@ (load "make-symbol.lsp") (load "symbol-name.lsp") (load "special-operator-p.lsp") - - diff --git a/ansi-tests/member.lsp b/ansi-tests/member.lsp index c7b0fe5524108100a72d8895d1c9b7ad638d7b08..2a50ea259affd9805a46859e5d8cf47f105c37a4 100644 --- a/ansi-tests/member.lsp +++ b/ansi-tests/member.lsp @@ -138,6 +138,14 @@ (member 'z '(a b c d) :key nil) nil) +(deftest member.20 + (member 10 '(1 2 3 4 10 11 14 18) :test #'<) + (11 14 18)) + +(deftest member.21 + (member 10 '(1 2 3 4 10 11 14 18) :test-not #'>=) + (11 14 18)) + ;;; Order of evaluation (deftest member.order.1 diff --git a/ansi-tests/nsublis.lsp b/ansi-tests/nsublis.lsp index 22ccb51d7b1c7ae062d962ce8915c24692ab350c..d6c15a0188e31c725ebb9b1d2fdc8ba990d01e0b 100644 --- a/ansi-tests/nsublis.lsp +++ b/ansi-tests/nsublis.lsp @@ -67,6 +67,19 @@ :key nil) (2 2 b b)) +(deftest nsublis.10 + (check-nsublis (list 0 3 8 20) + '((1 . x) (5 . y) (10 . z)) + :test #'(lambda (x y) (and (realp x) (realp y) (< x y)))) + (x y z 20)) + +(deftest nsublis.11 + (check-nsublis (list 0 3 8 20) + '((1 . x) (5 . y) (10 . z)) + :test-not + #'(lambda (x y) (not (and (realp x) (realp y) (< x y))))) + (x y z 20)) + ;;; 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 c089e8c8635976434d84d0fd69399bd0ad79d70d..14436fa27b9f21862f3b9d8fd986c1457c0cb8f9 100644 --- a/ansi-tests/nsubst.lsp +++ b/ansi-tests/nsubst.lsp @@ -62,6 +62,17 @@ :key nil) (a a c d a a)) +(deftest nsubst.10 + (check-nsubst 'x 10 (copy-tree '(1 2 10 20 30 4)) + :test #'(lambda (x y) (and (realp x) (realp y) (< x y)))) + (1 2 10 x x 4)) + +(deftest nsubst.11 + (check-nsubst 'x 10 (copy-tree '(1 2 10 20 30 4)) + :test-not #'(lambda (x y) + (not (and (realp x) (realp y) (< x y))))) + (1 2 10 x x 4)) + ;;; Order of argument evaluation (deftest nsubst.order.1 (let ((i 0) v w x y z) diff --git a/ansi-tests/pushnew.lsp b/ansi-tests/pushnew.lsp index b35ae8be34d363fa95d9fa7eb15d9c92e709e371..e82216f5787163d3031903d21bf611d991df35cb 100644 --- a/ansi-tests/pushnew.lsp +++ b/ansi-tests/pushnew.lsp @@ -154,6 +154,37 @@ (a b c) (a b c) 3 1 3 2) +(deftest pushnew.16 + (let ((x '(1 2 3))) + (values + (pushnew 10 x :test #'<=) + x)) + (10 1 2 3) + (10 1 2 3)) + +(deftest pushnew.17 + (let ((x '(1 2 3))) + (values + (pushnew 10 x :test #'>) + x)) + (1 2 3) + (1 2 3)) +(deftest pushnew.18 + (let ((x '(1 2 3))) + (values + (pushnew 10 x :test-not #'>) + x)) + (10 1 2 3) + (10 1 2 3)) + +(deftest pushnew.19 + (let ((x '(1 2 3))) + (values + (pushnew 10 x :test-not #'<=) + x)) + (1 2 3) + (1 2 3)) + (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 49877d2234d9e3a22ce1d85ac3fe88a5728d2985..9a8f4916170b617f5e0c816883c3c4e4dd615bcb 100644 --- a/ansi-tests/rassoc.lsp +++ b/ansi-tests/rassoc.lsp @@ -178,6 +178,16 @@ (eqt x y)))) (3 . a)) +(deftest rassoc.26 + (rassoc 10 '((a . 1) (b . 5) (c . 10) (d . 15) (e . 40)) + :test #'<) + (d . 15)) + +(deftest rassoc.27 + (rassoc 10 '((a . 1) (b . 5) (c . 10) (d . 15) (e . 40)) + :test-not #'>=) + (d . 15)) + ;;; Order of argument evaluation (deftest rassoc.order.1 diff --git a/ansi-tests/sublis.lsp b/ansi-tests/sublis.lsp index ccaf27dff2fdb891edafc29aed7ac9fea473795a..5b508a528275763c6af86cdf2c5b745f5d88f23d 100644 --- a/ansi-tests/sublis.lsp +++ b/ansi-tests/sublis.lsp @@ -63,6 +63,19 @@ :key nil) (2 2 b b)) +(deftest sublis.9 + (check-sublis (list 0 3 8 20) + '((1 . x) (5 . y) (10 . z)) + :test #'(lambda (x y) (and (realp x) (realp y) (< x y)))) + (x y z 20)) + +(deftest sublis.10 + (check-sublis (list 0 3 8 20) + '((1 . x) (5 . y) (10 . z)) + :test-not + #'(lambda (x y) (not (and (realp x) (realp y) (< x y))))) + (x y z 20)) + ;;; Order of argument evaluation (deftest sublis.order.1 (let ((i 0) w x y z) diff --git a/ansi-tests/subst.lsp b/ansi-tests/subst.lsp index dcdaba805f688a1602f2a6c5edb6c8afbdfe38a6..de9c877f4b6cabd5b3c9a035982a293bd5112ac6 100644 --- a/ansi-tests/subst.lsp +++ b/ansi-tests/subst.lsp @@ -61,6 +61,17 @@ :key nil) (a a c d a a)) +(deftest subst.10 + (check-subst 'x 10 (copy-tree '(1 2 10 20 30 4)) + :test #'(lambda (x y) (and (realp x) (realp y) (< x y)))) + (1 2 10 x x 4)) + +(deftest subst.11 + (check-subst 'x 10 (copy-tree '(1 2 10 20 30 4)) + :test-not #'(lambda (x y) + (not (and (realp x) (realp y) (< x y))))) + (1 2 10 x x 4)) + ;;; Order of argument evaluation (deftest subst.order.1 (let ((i 0) v w x y z) diff --git a/ansi-tests/tree-equal.lsp b/ansi-tests/tree-equal.lsp new file mode 100644 index 0000000000000000000000000000000000000000..c9bb3aaa2e788dd867f1e668d5be6613f4fb3834 --- /dev/null +++ b/ansi-tests/tree-equal.lsp @@ -0,0 +1,125 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Jun 14 07:23:03 2003 +;;;; Contains: Tests of TREE-EQUAL + +(in-package :cl-test) + +(deftest tree-equal.1 + (notnot-mv (tree-equal 'a 'a)) + t) + +(deftest tree-equal.2 + (tree-equal 'a 'b) + nil) + +(deftest tree-equal.3 + (notnot-mv (tree-equal (list 'a 'b (list 'c 'd)) + (list 'a 'b (list 'c 'd)))) + t) + +(deftest tree-equal.4 + (tree-equal '(a b c d) '(a b c e)) + nil) + +(deftest tree-equal.5 + (notnot-mv (tree-equal 1 2 :test #'<)) + t) + +(deftest tree-equal.6 + (notnot-mv (tree-equal 1 2 :test #'(lambda (x y) (values (< x y) t)))) + t) + +(deftest tree-equal.7 + (tree-equal 1 2 :test #'>) + nil) + +(deftest tree-equal.8 + (tree-equal (list 1) 2 :test (constantly t)) + nil) + +(deftest tree-equal.9 + (tree-equal (list 1) (list 2) + :test #'(lambda (x y) (or (and (consp x) (consp y)) + (eql x y)))) + nil) + +(deftest tree-equal.10 + (notnot-mv (tree-equal '(10 20 . 30) '(11 22 . 34) :test #'<)) + t) + +(deftest tree-equal.11 + (let* ((x (list 'a 'b)) + (y (list x x)) + (z (list (list 'a 'b) (list 'a 'b)))) + (notnot-mv (tree-equal y z))) + t) + +(deftest tree-equal.12 + (tree-equal 'a '(a b)) + nil) + +(deftest tree-equal.13 + (tree-equal '(a) '(a b)) + nil) + +(deftest tree-equal.14 + (tree-equal '(a b) '(a)) + nil) + +(deftest tree-equal.15 + (let ((x (vector 'a 'b 'c)) + (y (vector 'a' 'b 'c))) + (tree-equal x y)) + nil) + +(deftest tree-equal.16 + (let ((x (copy-seq "")) + (y (copy-seq ""))) + (tree-equal x y)) + nil) + +;;; Keywords tests + +(deftest tree-equal.allow-other-keys.1 + (notnot-mv (tree-equal '(a b) (list 'a 'b) :allow-other-keys nil)) + t) + +(deftest tree-equal.allow-other-keys.2 + (tree-equal '(a b) (list 'a 'c) :allow-other-keys nil :test #'eql) + nil) + +(deftest tree-equal.allow-other-keys.3 + (tree-equal '(a b) (list 'a 'z) :allow-other-keys t :foo t) + nil) + +(deftest tree-equal.allow-other-keys.4 + (notnot-mv (tree-equal '(a b) (list 'a 'b) :allow-other-keys t + :allow-other-keys nil :foo t)) + t) + +;;; Error tests + +(deftest tree-equal.error.1 + (classify-error (tree-equal)) + program-error) + +(deftest tree-equal.error.2 + (classify-error (tree-equal '(a b))) + program-error) + +(deftest tree-equal.error.3 + (classify-error (tree-equal '(a b) '(a b) (gensym) t)) + program-error) + +(deftest tree-equal.error.4 + (classify-error (tree-equal '(a b) '(a b) (gensym) t :allow-other-keys nil)) + program-error) + + + + + + + + \ No newline at end of file