Commit 6f4c0e0b authored by pfdietz's avatar pfdietz

Added test file for BOUNDP. Added :allow-other-keys tests to cons-related functions.

parent 3d42f668
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Tue Jan 14 05:58:01 2003
;;;; Contains: Tests for BOUNDP
(in-package :cl-test)
(deftest boundp.error.1
(classify-error (boundp))
program-error)
(deftest boundp.error.2
(classify-error (boundp 'a 'a))
program-error)
(deftest boundp.error.3
(classify-error (boundp 1))
type-error)
(deftest boundp.error.4
(classify-error (boundp '(setf car)))
type-error)
(deftest boundp.error.5
(classify-error (boundp "abc"))
type-error)
;;; See other tests in cl-symbols.lsp
(deftest boundp.1
(notnot (boundp 't))
t)
(deftest boundp.2
(notnot (boundp nil))
t)
(deftest boundp.3
(notnot (boundp :foo))
t)
(deftest boundp.4
(boundp '#:foo)
nil)
......@@ -485,7 +485,7 @@
a)
(deftest nsubst-if-not-6
(nsubst-if 'a #'identity nil :bad t :allow-other-keys t)
(nsubst-if-not 'a #'null nil :bad t :allow-other-keys t)
nil)
;;; Error cases
......
......@@ -194,6 +194,19 @@
(eqt x y))))
(A . 3))
(deftest assoc-26
(assoc 'b '((a . 1) (b . 2) (c . 3)) :bad t :allow-other-keys t)
(b . 2))
(deftest assoc-27
(assoc 'b '((a . 1) (b . 2) (c . 3)) :allow-other-keys t :also-bad t)
(b . 2))
(deftest assoc-28
(assoc 'b '((a . 1) (b . 2) (c . 3)) :allow-other-keys t :also-bad t
:test-not #'eql)
(a . 1))
(deftest assoc.error.1
(classify-error (assoc))
program-error)
......@@ -255,6 +268,22 @@
(assoc-if #'null '((a . b) nil (c . d) (nil . e) (f . g)))
(nil . e))
(deftest assoc-if-5
(assoc-if #'null '((a . 1) (nil . 2) (c . 3)) :bad t :allow-other-keys t)
(nil . 2))
(deftest assoc-if-6
(assoc-if #'null '((a . 1) (nil . 2) (c . 3))
:allow-other-keys t :also-bad t)
(nil . 2))
(deftest assoc-if-7
(assoc-if #'null '((a . 1) (nil . 2) (c . 3))
:allow-other-keys t :also-bad t :key #'not)
(a . 1))
;;; Error cases
(deftest assoc-if.error.1
(classify-error (assoc-if))
program-error)
......@@ -316,6 +345,21 @@
(assoc-if-not #'identity '((a . b) nil (c . d) (nil . e) (f . g)))
(nil . e))
(deftest assoc-if-not-5
(assoc-if-not #'identity
'((a . 1) (nil . 2) (c . 3)) :bad t :allow-other-keys t)
(nil . 2))
(deftest assoc-if-not-6
(assoc-if-not #'identity '((a . 1) (nil . 2) (c . 3))
:allow-other-keys t :also-bad t)
(nil . 2))
(deftest assoc-if-not-7
(assoc-if-not #'identity '((a . 1) (nil . 2) (c . 3))
:allow-other-keys t :also-bad t :key #'not)
(a . 1))
(deftest assoc-if-not.error.1
(classify-error (assoc-if-not))
program-error)
......@@ -439,6 +483,3 @@
(deftest pairlis.error.3
(classify-error (pairlis nil nil nil nil))
program-error)
......@@ -191,6 +191,19 @@
(eqt x y))))
(3 . A))
(deftest rassoc-26
(rassoc 'b '((1 . a) (2 . b) (3 . c)) :bad t :allow-other-keys t)
(2 . b))
(deftest rassoc-27
(rassoc 'b '((1 . a) (2 . b) (3 . c)) :allow-other-keys t :bad t)
(2 . b))
(deftest rassoc-28
(rassoc 'a '((1 . a) (2 . b) (3 . c)) :allow-other-keys t :bad t
:test-not #'eql)
(2 . b))
(deftest rassoc.error.1
(classify-error (rassoc))
program-error)
......@@ -254,6 +267,19 @@
(rev-assoc-list '((a . b) nil (c . d) (nil . e) (f . g))))
(e))
(deftest rassoc-if-26
(rassoc-if #'null '((1 . a) (2) (3 . c)) :bad t :allow-other-keys t)
(2))
(deftest rassoc-if-27
(rassoc-if #'null '((1 . a) (2) (3 . c)) :allow-other-keys t :bad t)
(2))
(deftest rassoc-if-28
(rassoc-if #'identity '((1 . a) (2) (3 . c)) :allow-other-keys t :bad t
:key 'not)
(2))
(deftest rassoc-if.error.1
(classify-error (rassoc-if))
program-error)
......@@ -316,6 +342,19 @@
(rev-assoc-list '((a . b) nil (c . d) (nil . e) (f . g))))
(e))
(deftest rassoc-if-not-26
(rassoc-if-not #'identity '((1 . a) (2) (3 . c)) :bad t :allow-other-keys t)
(2))
(deftest rassoc-if-not-27
(rassoc-if-not #'values '((1 . a) (2) (3 . c)) :allow-other-keys t :bad t)
(2))
(deftest rassoc-if-not-28
(rassoc-if-not #'not '((1 . a) (2) (3 . c)) :allow-other-keys t :bad t
:key 'not)
(2))
(deftest rassoc-if-not.error.1
(classify-error (rassoc-if-not))
program-error)
......
......@@ -235,6 +235,25 @@
(not (eql x y))))))
(4))
(deftest intersection-19
(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
(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
(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.error.1
(classify-error (intersection))
program-error)
......@@ -451,6 +470,25 @@
(not (eql x y))))))
(4))
(deftest nintersection-19
(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
(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
(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.error.1
(classify-error (nintersection))
program-error)
......
......@@ -187,7 +187,7 @@
#'<))))
(1 4 6 10 44 101))
;; Check that union uses eql, not equal or eq
;;; Check that union uses eql, not equal or eq
(deftest union-26
(let ((x 1000)
......@@ -264,6 +264,26 @@
#'<))
(1 2 3 4 5 6))
(deftest union-32
(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
(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
(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.error.1
(classify-error (union))
program-error)
......
......@@ -263,6 +263,25 @@
#'<))
(1 2 3 4 5 6))
(deftest nunion-32
(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
(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
(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.error.1
(classify-error (nunion))
program-error)
......
......@@ -149,6 +149,34 @@
#'<))
(1 2 3 4))
(deftest set-difference-20
(sort
(copy-list
(set-difference
'(1 2 3 4 5) '(2 3 4)
:bad t :allow-other-keys t))
#'<)
(1 5))
(deftest set-difference-21
(sort
(copy-list
(set-difference
'(1 2 3 4 5) '(2 3 4)
:allow-other-keys t :bad t))
#'<)
(1 5))
(deftest set-difference-22
(sort
(copy-list
(set-difference
'(1 2 3 4 5) '(2 3 4)
:allow-other-keys t :bad t :test #'(lambda (x y) (= x (1- y)))))
#'<)
(4 5))
(deftest set-difference.error.1
(classify-error (set-difference))
program-error)
......@@ -314,6 +342,33 @@
#'<))
(1 2 3 4))
(deftest nset-difference-20
(sort
(copy-list
(nset-difference
(list 1 2 3 4 5) (list 2 3 4)
:bad t :allow-other-keys t))
#'<)
(1 5))
(deftest nset-difference-21
(sort
(copy-list
(nset-difference
(list 1 2 3 4 5) (list 2 3 4)
:allow-other-keys t :bad t))
#'<)
(1 5))
(deftest nset-difference-22
(sort
(copy-list
(nset-difference
(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 nset-difference.error.1
(classify-error (nset-difference))
program-error)
......
......@@ -171,6 +171,25 @@
t))))))
t)
(deftest set-exclusive-or-19
(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
(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
(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-or.error.1
(classify-error (set-exclusive-or))
program-error)
......@@ -360,6 +379,25 @@
t))))))
t)
(deftest nset-exclusive-or-19
(sort (nset-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
:bad t :allow-other-keys t)
#'<)
(1 2 5 6))
(deftest nset-exclusive-or-20
(sort (nset-exclusive-or (list 1 2 3 4) (list 3 4 5 6)
:allow-other-keys t :bad t)
#'<)
(1 2 5 6))
(deftest nset-exclusive-or-21
(sort (nset-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 nset-exclusive-or.error.1
(classify-error (nset-exclusive-or))
program-error)
......
......@@ -126,6 +126,22 @@
nil)))
t)
(deftest subsetp-16
(notnot (subsetp '(1 2 3 4) '(0 1 2 3 4 5) :bad t :allow-other-keys 67))
t)
(deftest subsetp-17
(notnot (subsetp '(1 2 3 4) '(0 1 2 3 4 5)
:allow-other-keys #'cons :bad t))
t)
(deftest subsetp-18
(notnot (subsetp '(1 2 3 4) '(0 1 2 3 4)
:allow-other-keys (make-hash-table)
:bad t
:test #'(lambda (x y) (= (1+ x) y))))
nil)
(deftest subsetp.error.1
(classify-error (subsetp))
program-error)
......
......@@ -4,6 +4,7 @@
(compile-and-load "cl-symbols-aux.lsp")
(load "cl-symbol-names.lsp")
(load "cl-symbols.lsp")
(load "boundp.lsp")
;;; Tests of evaluation and compilation
(load "eval.lsp")
......
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