Commit cc13e5d6 authored by pfdietz's avatar pfdietz
Browse files

Added tests for TREE-EQUAL, and order of arguments tests for :TEST and...

Added tests for TREE-EQUAL, and order of arguments tests for :TEST and :TEST-NOT functions in various places.
parent 5023f0ed
...@@ -84,6 +84,25 @@ ...@@ -84,6 +84,25 @@
:test-not (complement #'equal) :key nil) :test-not (complement #'equal) :key nil)
(aaa "AAA" "aaa" #\a)) (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 (deftest adjoin.order.1
(let ((i 0) w x y z) (let ((i 0) w x y z)
(values (values
......
...@@ -140,6 +140,16 @@ ...@@ -140,6 +140,16 @@
(eqt x y)))) (eqt x y))))
(a . 3)) (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 ;;; Order of argument evaluation
(deftest assoc.order.1 (deftest assoc.order.1
......
...@@ -79,6 +79,14 @@ ...@@ -79,6 +79,14 @@
:test #'(lambda (x y) (declare (ignore x y)) t)) :test #'(lambda (x y) (declare (ignore x y)) t))
5) 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 ;;; On vectors
(deftest count-vector.1 (deftest count-vector.1
...@@ -150,11 +158,19 @@ ...@@ -150,11 +158,19 @@
(count 1 #(1 1 1 1 1 2 1 1) :test-not #'eql) (count 1 #(1 1 1 1 1 2 1 1) :test-not #'eql)
1) 1)
(deftest count-vector16 (deftest count-vector.16
(count 1 #(1 1 1 3 1 2 1 1) :start 2 :end 7 (count 1 #(1 1 1 3 1 2 1 1) :start 2 :end 7
:test #'(lambda (x y) (declare (ignore x y)) t)) :test #'(lambda (x y) (declare (ignore x y)) t))
5) 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 ;;; Non-simple vectors
(deftest count-filled-vector.1 (deftest count-filled-vector.1
...@@ -384,6 +400,13 @@ ...@@ -384,6 +400,13 @@
:end 4) :end 4)
3) 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 ;;; Tests on strings
...@@ -486,6 +509,14 @@ ...@@ -486,6 +509,14 @@
:start 2 :end 5) :start 2 :end 5)
3) 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 ;;; Argument order tests
(deftest count.order.1 (deftest count.order.1
......
...@@ -150,6 +150,14 @@ ...@@ -150,6 +150,14 @@
:start 2 :from-end t) :start 2 :from-end t)
(a b)) (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 ;;; Tests on vectors
(deftest find-vector.1 (deftest find-vector.1
...@@ -320,6 +328,14 @@ ...@@ -320,6 +328,14 @@
(loop for i from 1 to 5 collect (find i a :from-end t :key #'car))) (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))) ((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 ;;; tests on bit vectors
(deftest find-bit-vector.1 (deftest find-bit-vector.1
...@@ -593,6 +609,22 @@ ...@@ -593,6 +609,22 @@
(values (find 0 a) (find 0 a :from-end t))) (values (find 0 a) (find 0 a :from-end t)))
0 0) 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 ;;; strings
(deftest find-string.1 (deftest find-string.1
...@@ -741,6 +773,14 @@ ...@@ -741,6 +773,14 @@
(#\a #\b #\c #\d #\e nil nil nil nil nil) (#\a #\b #\c #\d #\e nil nil nil nil nil)
(#\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 ;;; Keyword tests
(deftest find.allow-other-keys.1 (deftest find.allow-other-keys.1
......
...@@ -9,6 +9,7 @@ ...@@ -9,6 +9,7 @@
(load "rplaca.lsp") (load "rplaca.lsp")
(load "rplacd.lsp") (load "rplacd.lsp")
(load "copy-tree.lsp") (load "copy-tree.lsp")
(load "tree-equal.lsp")
(load "sublis.lsp") (load "sublis.lsp")
(load "nsublis.lsp") (load "nsublis.lsp")
(load "subst.lsp") (load "subst.lsp")
......
...@@ -9,5 +9,3 @@ ...@@ -9,5 +9,3 @@
(load "make-symbol.lsp") (load "make-symbol.lsp")
(load "symbol-name.lsp") (load "symbol-name.lsp")
(load "special-operator-p.lsp") (load "special-operator-p.lsp")
...@@ -138,6 +138,14 @@ ...@@ -138,6 +138,14 @@
(member 'z '(a b c d) :key nil) (member 'z '(a b c d) :key nil)
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 ;;; Order of evaluation
(deftest member.order.1 (deftest member.order.1
......
...@@ -67,6 +67,19 @@ ...@@ -67,6 +67,19 @@
:key nil) :key nil)
(2 2 b b)) (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 ;;; Order of argument evaluation
(deftest nsublis.order.1 (deftest nsublis.order.1
(let ((i 0) w x y z) (let ((i 0) w x y z)
......
...@@ -62,6 +62,17 @@ ...@@ -62,6 +62,17 @@
:key nil) :key nil)
(a a c d a a)) (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 ;;; Order of argument evaluation
(deftest nsubst.order.1 (deftest nsubst.order.1
(let ((i 0) v w x y z) (let ((i 0) v w x y z)
......
...@@ -154,6 +154,37 @@ ...@@ -154,6 +154,37 @@
(a b c) (a b c) (a b c) (a b c)
3 1 3 2) 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 (deftest pushnew.order.1
(let ((x (vector nil nil nil nil)) (let ((x (vector nil nil nil nil))
(y (vector 'a 'b 'c 'd)) (y (vector 'a 'b 'c 'd))
......
...@@ -178,6 +178,16 @@ ...@@ -178,6 +178,16 @@
(eqt x y)))) (eqt x y))))
(3 . a)) (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 ;;; Order of argument evaluation
(deftest rassoc.order.1 (deftest rassoc.order.1
......
...@@ -63,6 +63,19 @@ ...@@ -63,6 +63,19 @@
:key nil) :key nil)
(2 2 b b)) (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 ;;; Order of argument evaluation
(deftest sublis.order.1 (deftest sublis.order.1
(let ((i 0) w x y z) (let ((i 0) w x y z)
......
...@@ -61,6 +61,17 @@ ...@@ -61,6 +61,17 @@
:key nil) :key nil)
(a a c d a a)) (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 ;;; Order of argument evaluation
(deftest subst.order.1 (deftest subst.order.1
(let ((i 0) v w x y z) (let ((i 0) v w x y z)
......
;-*- 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
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