Commit b61572a8 authored by pfdietz's avatar pfdietz

Added more tests of keyword handling (mostly :allow-other-keys) in cons-related functions.

parent ce9d2a25
......@@ -65,12 +65,12 @@
(member-if #'identity '(nil 2 3 4 5) :allow-other-keys nil)
(2 3 4 5))
(deftest member-if.allow-other-keys.5
(deftest member-if.allow-other-keys.6
(member-if #'identity '(nil 2 3 4 5) :allow-other-keys t
:allow-other-keys nil)
(2 3 4 5))
(deftest member-if.allow-other-keys.6
(deftest member-if.allow-other-keys.7
(member-if #'identity '(nil 2 3 4 5) :allow-other-keys t
:allow-other-keys nil :key #'identity :key #'null)
(2 3 4 5))
......
......@@ -16,7 +16,7 @@
(acons (cdar x) (caar x) (rev-assoc-list (cdr x))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; assoc
;;; rassoc
(deftest rassoc-1
(rassoc nil nil)
......@@ -191,19 +191,36 @@
(eqt x y))))
(3 . A))
(deftest rassoc-26
;;; Keyword tests
(deftest rassoc.allow-other-keys.1
(rassoc 'b '((1 . a) (2 . b) (3 . c)) :bad t :allow-other-keys t)
(2 . b))
(deftest rassoc-27
(deftest rassoc.allow-other-keys.2
(rassoc 'b '((1 . a) (2 . b) (3 . c)) :allow-other-keys t :bad t)
(2 . b))
(deftest rassoc-28
(deftest rassoc.allow-other-keys.3
(rassoc 'a '((1 . a) (2 . b) (3 . c)) :allow-other-keys t :bad t
:test-not #'eql)
(2 . b))
(deftest rassoc.allow-other-keys.4
(rassoc 'b '((1 . a) (2 . b) (3 . c)) :allow-other-keys t)
(2 . b))
(deftest rassoc.allow-other-keys.5
(rassoc 'b '((1 . a) (2 . b) (3 . c)) :allow-other-keys nil)
(2 . b))
(deftest rassoc.keywords.6
(rassoc 'b '((1 . a) (2 . b) (3 . c))
:test #'eql :test (complement #'eql))
(2 . b))
;;; Error tests
(deftest rassoc.error.1
(classify-error (rassoc))
program-error)
......@@ -267,19 +284,35 @@
(rev-assoc-list '((a . b) nil (c . d) (nil . e) (f . g))))
(e))
(deftest rassoc-if-26
;;; Keyword tests
(deftest rassoc-if.allow-other-keys.1
(rassoc-if #'null '((1 . a) (2) (3 . c)) :bad t :allow-other-keys t)
(2))
(deftest rassoc-if-27
(deftest rassoc-if.allow-other-keys.2
(rassoc-if #'null '((1 . a) (2) (3 . c)) :allow-other-keys t :bad t)
(2))
(deftest rassoc-if-28
(deftest rassoc-if.allow-other-keys.3
(rassoc-if #'identity '((1 . a) (2) (3 . c)) :allow-other-keys t :bad t
:key 'not)
(2))
(deftest rassoc-if.allow-other-keys.4
(rassoc-if #'null '((1 . a) (2) (3 . c)) :allow-other-keys t)
(2))
(deftest rassoc-if.allow-other-keys.5
(rassoc-if #'null '((1 . a) (2) (3 . c)) :allow-other-keys nil)
(2))
(deftest rassoc-if.keywords.6
(rassoc-if #'identity '((1 . a) (2) (3 . c)) :key #'not :key #'identity)
(2))
;;; Error tests
(deftest rassoc-if.error.1
(classify-error (rassoc-if))
program-error)
......@@ -342,19 +375,40 @@
(rev-assoc-list '((a . b) nil (c . d) (nil . e) (f . g))))
(e))
(deftest rassoc-if-not-26
;;; Keyword tests
(deftest rassoc-if-not.allow-other-keys.1
(rassoc-if-not #'identity '((1 . a) (2) (3 . c)) :bad t :allow-other-keys t)
(2))
(deftest rassoc-if-not-27
(deftest rassoc-if-not.allow-other-keys.2
(rassoc-if-not #'values '((1 . a) (2) (3 . c)) :allow-other-keys t :bad t)
(2))
(deftest rassoc-if-not-28
(deftest rassoc-if-not.allow-other-keys.3
(rassoc-if-not #'not '((1 . a) (2) (3 . c)) :allow-other-keys t :bad t
:key 'not)
(2))
(deftest rassoc-if-not.allow-other-keys.4
(rassoc-if-not #'identity '((1 . a) (2) (3 . c)) :allow-other-keys t)
(2))
(deftest rassoc-if-not.allow-other-keys.5
(rassoc-if-not #'identity '((1 . a) (2) (3 . c)) :allow-other-keys nil)
(2))
(deftest rassoc-if-not.allow-other-keys.6
(rassoc-if-not #'identity '((1 . a) (2) (3 . c)) :allow-other-keys t
:allow-other-keys nil :bad t)
(2))
(deftest rassoc-if-not.keywords.7
(rassoc-if-not #'identity '((1 . a) (2) (3 . c)) :key #'not :key nil)
(1 . a))
;;; Error tests
(deftest rassoc-if-not.error.1
(classify-error (rassoc-if-not))
program-error)
......
......@@ -235,25 +235,68 @@
(not (eql x y))))))
(4))
(deftest intersection-19
;;; Keyword tests
(deftest intersection.allow-other-keys.1
(let ((list1 (list 1 2 3 4))
(list2 (list 4 5 6 7)))
(intersection list1 list2 :bad t :allow-other-keys 1))
(4))
(deftest intersection-20
(deftest intersection.allow-other-keys.2
(let ((list1 (list 1 2 3 4))
(list2 (list 4 5 6 7)))
(intersection list1 list2 :allow-other-keys :foo :also-bad t))
(4))
(deftest intersection-21
(deftest intersectionallow-other-keys.3
(let ((list1 (list 1 2 3 4))
(list2 (list 4 5 6 7)))
(intersection list1 list2 :allow-other-keys :foo :also-bad t
:test #'(lambda (x y) (= x (1+ y)))))
nil)
(deftest intersection.allow-other-keys.4
(let ((list1 (list 1 2 3 4))
(list2 (list 4 5 6 7)))
(intersection list1 list2 :allow-other-keys t))
(4))
(deftest intersection.allow-other-keys.5
(let ((list1 (list 1 2 3 4))
(list2 (list 4 5 6 7)))
(intersection list1 list2 :allow-other-keys nil))
(4))
(deftest intersection.allow-other-keys.6
(let ((list1 (list 1 2 3 4))
(list2 (list 4 5 6 7)))
(intersection list1 list2 :allow-other-keys t
:allow-other-keys nil :bad t))
(4))
(deftest intersection.allow-other-keys.7
(sort
(let ((list1 (list 1 2 3 4))
(list2 (list 4 5 6 7)))
(intersection list1 list2 :allow-other-keys t
:allow-other-keys nil
:test #'(lambda (x y) (eql x (1- y)))))
#'<)
(3 4))
(deftest intersection.keywords.8
(sort
(let ((list1 (list 1 2 3 4))
(list2 (list 4 5 6 7)))
(intersection list1 list2
:test #'(lambda (x y) (eql x (1- y)))
:test #'eql))
#'<)
(3 4))
;;; Error tests
(deftest intersection.error.1
(classify-error (intersection))
program-error)
......@@ -470,19 +513,67 @@
(not (eql x y))))))
(4))
(deftest nintersection-19
;;; Keyword tests
(deftest nintersection.allow-other-keys.1
(let ((list1 (list 1 2 3 4))
(list2 (list 4 5 6 7)))
(nintersection list1 list2 :bad t :allow-other-keys 1))
(4))
(deftest nintersection-20
(deftest nintersection.allow-other-keys.2
(let ((list1 (list 1 2 3 4))
(list2 (list 4 5 6 7)))
(nintersection list1 list2 :allow-other-keys :foo :also-bad t))
(4))
(deftest nintersection-21
(deftest nintersectionallow-other-keys.3
(let ((list1 (list 1 2 3 4))
(list2 (list 4 5 6 7)))
(nintersection list1 list2 :allow-other-keys :foo :also-bad t
:test #'(lambda (x y) (= x (1+ y)))))
nil)
(deftest nintersection.allow-other-keys.4
(let ((list1 (list 1 2 3 4))
(list2 (list 4 5 6 7)))
(nintersection list1 list2 :allow-other-keys t))
(4))
(deftest nintersection.allow-other-keys.5
(let ((list1 (list 1 2 3 4))
(list2 (list 4 5 6 7)))
(nintersection list1 list2 :allow-other-keys nil))
(4))
(deftest nintersection.allow-other-keys.6
(let ((list1 (list 1 2 3 4))
(list2 (list 4 5 6 7)))
(nintersection list1 list2 :allow-other-keys t
:allow-other-keys nil :bad t))
(4))
(deftest nintersection.allow-other-keys.7
(sort
(let ((list1 (list 1 2 3 4))
(list2 (list 4 5 6 7)))
(nintersection list1 list2 :allow-other-keys t
:allow-other-keys nil
:test #'(lambda (x y) (eql x (1- y)))))
#'<)
(3 4))
(deftest nintersection.keywords.8
(sort
(let ((list1 (list 1 2 3 4))
(list2 (list 4 5 6 7)))
(nintersection list1 list2
:test #'(lambda (x y) (eql x (1- y)))
:test #'eql))
#'<)
(3 4))
(deftest nintersection.allow-other-keys.9
(let ((list1 (list 1 2 3 4))
(list2 (list 4 5 6 7)))
(nintersection list1 list2 :allow-other-keys :foo :also-bad t
......
......@@ -264,25 +264,62 @@
#'<))
(1 2 3 4 5 6))
(deftest union-32
;;; Keyword tests
(deftest union.allow-other-keys.1
(sort (union (list 7 9 1 5) (list 10 11 9 20 1 2) :bad t
:allow-other-keys "yes")
#'<)
(1 2 5 7 9 10 11 20))
(deftest union-33
(deftest union.allow-other-keys.2
(sort (union (list 7 9 1 5) (list 10 11 9 20 1 2)
:allow-other-keys t :also-bad t)
#'<)
(1 2 5 7 9 10 11 20))
(deftest union-34
(deftest union.allow-other-keys.3
(sort (union (list 1 2 3) (list 1 2 3)
:allow-other-keys t :also-bad t
:test #'(lambda (x y) (= x (+ y 100))))
#'<)
(1 1 2 2 3 3))
(deftest union.allow-other-keys.4
(sort (union (list 7 9 1 5) (list 10 11 9 20 1 2)
:allow-other-keys t)
#'<)
(1 2 5 7 9 10 11 20))
(deftest union.allow-other-keys.5
(sort (union (list 7 9 1 5) (list 10 11 9 20 1 2)
:allow-other-keys nil)
#'<)
(1 2 5 7 9 10 11 20))
(deftest union.allow-other-keys.6
(sort (union (list 7 9 1 5) (list 10 11 9 20 1 2)
:allow-other-keys t
:allow-other-keys nil)
#'<)
(1 2 5 7 9 10 11 20))
(deftest union.allow-other-keys.7
(sort (union (list 7 9 1 5) (list 10 11 9 20 1 2)
:allow-other-keys t
:allow-other-keys nil
'#:x 1)
#'<)
(1 2 5 7 9 10 11 20))
(deftest union.keywords.9
(sort (union (list 1 2 3) (list 1 2 3)
:test #'(lambda (x y) (= x (+ y 100)))
:test #'eql)
#'<)
(1 1 2 2 3 3))
;;; Error tests
(deftest union.error.1
(classify-error (union))
......
......@@ -263,25 +263,63 @@
#'<))
(1 2 3 4 5 6))
(deftest nunion-32
;;; Keyword tests
(deftest nunion.allow-other-keys.1
(sort (nunion (list 7 9 1 5) (list 10 11 9 20 1 2) :bad t
:allow-other-keys "yes")
#'<)
(1 2 5 7 9 10 11 20))
(deftest nunion-33
(deftest nunion.allow-other-keys.2
(sort (nunion (list 7 9 1 5) (list 10 11 9 20 1 2)
:allow-other-keys t :also-bad t)
#'<)
(1 2 5 7 9 10 11 20))
(deftest nunion-34
(deftest nunion.allow-other-keys.3
(sort (nunion (list 1 2 3) (list 1 2 3)
:allow-other-keys t :also-bad t
:test #'(lambda (x y) (= x (+ y 100))))
#'<)
(1 1 2 2 3 3))
(deftest nunion.allow-other-keys.4
(sort (nunion (list 7 9 1 5) (list 10 11 9 20 1 2)
:allow-other-keys t)
#'<)
(1 2 5 7 9 10 11 20))
(deftest nunion.allow-other-keys.5
(sort (nunion (list 7 9 1 5) (list 10 11 9 20 1 2)
:allow-other-keys nil)
#'<)
(1 2 5 7 9 10 11 20))
(deftest nunion.allow-other-keys.6
(sort (nunion (list 7 9 1 5) (list 10 11 9 20 1 2)
:allow-other-keys t
:allow-other-keys nil)
#'<)
(1 2 5 7 9 10 11 20))
(deftest nunion.allow-other-keys.7
(sort (nunion (list 7 9 1 5) (list 10 11 9 20 1 2)
:allow-other-keys t
:allow-other-keys nil
'#:x 1)
#'<)
(1 2 5 7 9 10 11 20))
(deftest nunion.keywords.9
(sort (nunion (list 1 2 3) (list 1 2 3)
:test #'(lambda (x y) (= x (+ y 100)))
:test #'eql)
#'<)
(1 1 2 2 3 3))
;;; Error tests
(deftest nunion.error.1
(classify-error (nunion))
program-error)
......
......@@ -149,33 +149,94 @@
#'<))
(1 2 3 4))
(deftest set-difference-20
;;; Keyword tests
(deftest set-difference.allow-other-keys.1
(sort
(copy-list
(set-difference
'(1 2 3 4 5) '(2 3 4)
(list 1 2 3 4 5) (list 2 3 4)
:bad t :allow-other-keys t))
#'<)
(1 5))
(deftest set-difference-21
(deftest set-difference.allow-other-keys.2
(sort
(copy-list
(set-difference
'(1 2 3 4 5) '(2 3 4)
(list 1 2 3 4 5) (list 2 3 4)
:allow-other-keys t :bad t))
#'<)
(1 5))
(deftest set-difference-22
(deftest set-difference.allow-other-keys.3
(sort
(copy-list
(set-difference
'(1 2 3 4 5) '(2 3 4)
(list 1 2 3 4 5) (list 2 3 4)
:allow-other-keys t :bad t :test #'(lambda (x y) (= x (1- y)))))
#'<)
(4 5))
(deftest set-difference.allow-other-keys.4
(sort
(copy-list
(set-difference
(list 1 2 3 4 5) (list 2 3 4)
:allow-other-keys t))
#'<)
(1 5))
(deftest set-difference.allow-other-keys.5
(sort
(copy-list
(set-difference
(list 1 2 3 4 5) (list 2 3 4)
:allow-other-keys nil))
#'<)
(1 5))
(deftest set-difference.allow-other-keys.6
(sort
(copy-list
(set-difference
(list 1 2 3 4 5) (list 2 3 4)
:allow-other-keys t
:allow-other-keys nil))
#'<)
(1 5))
(deftest set-difference.allow-other-keys.7
(sort
(copy-list
(set-difference
(list 1 2 3 4 5) (list 2 3 4)
:allow-other-keys t
:allow-other-keys nil
'#:x 1))
#'<)
(1 5))
(deftest set-difference.keywords.8
(sort
(copy-list
(set-difference
(list 1 2 3 4 5) (list 2 3 4)
:test #'eql :test (complement #'eql)))
#'<)
(1 5))
(deftest set-difference.keywords.9
(sort
(copy-list
(set-difference
(list 1 2 3 4 5) (list 2 3 4)
:test (complement #'eql) :test #'eql))
#'<)
nil)
;;; Error tests
(deftest set-difference.error.1
(classify-error (set-difference))
......@@ -342,7 +403,9 @@
#'<))
(1 2 3 4))
(deftest nset-difference-20
;;; Keyword tests
(deftest nset-difference.allow-other-keys.1
(sort
(copy-list
(nset-difference
......@@ -351,7 +414,7 @@
#'<)
(1 5))
(deftest nset-difference-21
(deftest nset-difference.allow-other-keys.2
(sort
(copy-list
(nset-difference
......@@ -360,7 +423,7 @@
#'<)
(1 5))
(deftest nset-difference-22
(deftest nset-difference.allow-other-keys.3
(sort
(copy-list
(nset-difference
......@@ -369,6 +432,65 @@
#'<)
(4 5))
(deftest nset-difference.allow-other-keys.4
(sort
(copy-list
(nset-difference
(list 1 2 3 4 5) (list 2 3 4)
:allow-other-keys t))
#'<)
(1 5))
(deftest nset-difference.allow-other-keys.5
(sort
(copy-list
(nset-difference
(list 1 2 3 4 5) (list 2 3 4)
:allow-other-keys nil))
#'<)
(1 5))
(deftest nset-difference.allow-other-keys.6
(sort
(copy-list
(nset-difference
(list 1 2 3 4 5) (list 2 3 4)
:allow-other-keys t
:allow-other-keys nil))
#'<)
(1 5))
(deftest nset-difference.allow-other-keys.7
(sort
(copy-list
(nset-difference
(list 1 2 3 4 5) (list 2 3 4)
:allow-other-keys t
:allow-other-keys nil
'#:x 1))
#'<)
(1 5))
(deftest nset-difference.keywords.8
(sort
(copy-list
(nset-difference
(list 1 2 3 4 5) (list 2 3 4)
:test #'eql :test (complement #'eql)))
#'<)
(1 5))
(deftest nset-difference.keywords.9
(sort
(copy-list
(nset-difference
(list 1 2 3 4 5) (list 2 3 4)
:test (complement #'eql) :test #'eql))
#'<)
nil)
;;; Error tests
(deftest nset-difference.error.1
(classify-error (nset-difference))
program-error)
......
......@@ -171,25 +171,68 @@
t))))))
t)
(deftest set-exclusive-or-19
;;; Keyword tests
(deftest set-exclusive.allow-other-keys.1
(sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
:bad t :allow-other-keys t)
#'<)
(1 2 5 6))
(deftest set-exclusive-or-20
(deftest set-exclusive.allow-other-keys.2
(sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
:allow-other-keys t :bad t)
#'<)
(1 2 5 6))
(deftest set-exclusive-or-21
(deftest set-exclusive.allow-other-keys.3
(sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
:allow-other-keys t :bad t
:test #'(lambda (x y) (= x (1- y))))
#'<)
(1 6))
(deftest set-exclusive.allow-other-keys.4
(sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
:allow-other-keys t)
#'<)
(1 2 5 6))
(deftest set-exclusive.allow-other-keys.5
(sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
:allow-other-keys nil)
#'<)
(1 2 5 6))
(deftest set-exclusive.allow-other-keys.6
(sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
:allow-other-keys t
:allow-other-keys nil)
#'<)
(1 2 5 6))
(deftest set-exclusive.allow-other-keys.7
(sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
:allow-other-keys t
:allow-other-keys nil
'#:x 1)
#'<)
(1 2 5 6))
(deftest set-exclusive.keywords.8
(sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
:test #'eql
:test #'/=)
#'<)
(1 2 5 6))
(deftest set-exclusive.keywords.9
(sort (set-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
:test #'/=