Commit cc13e5d6 authored by pfdietz's avatar pfdietz

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 @@
: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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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")
......
......@@ -9,5 +9,3 @@
(load "make-symbol.lsp")
(load "symbol-name.lsp")
(load "special-operator-p.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
......
......@@ -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)
......
......@@ -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)
......
......@@ -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))
......
......@@ -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
......
......@@ -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)
......
......@@ -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)
......
;-*- 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