Commit 263b709a authored by pfdietz's avatar pfdietz

Muffled style warnings during test execution. Added more tests for argument order-of-execution.

parent e0725c20
......@@ -10,19 +10,19 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; member-if
(deftest member-if-1
(deftest member-if.1
(member-if #'listp nil)
nil)
(deftest member-if-2
(deftest member-if.2
(member-if #'(lambda (x) (eqt x 'a)) '(1 2 a 3 4))
(a 3 4))
(deftest member-if-3
(deftest member-if.3
(member-if #'(lambda (x) (eql x 12)) '(4 12 11 73 11) :key #'1+)
(11 73 11))
(deftest member-if-4
(deftest member-if.4
(let ((test-inputs
`(1 a 11.3121 11.31s3 1.123f5 -1 0
13.13122d34 581.131e-10
......@@ -40,10 +40,36 @@
test-inputs)))
t)
(deftest member-if-5
(deftest member-if.5
(member-if #'identity '(1 2 3 4 5) :key #'evenp)
(2 3 4 5))
;;; Order of argument tests
(deftest member-if.6
(let ((i 0) x y)
(values
(member-if (progn (setf x (incf i))
#'identity)
(progn (setf y (incf i))
'(nil nil a b nil c d)))
i x y))
(a b nil c d) 2 1 2)
(deftest member-if.7
(let ((i 0) x y z w)
(values
(member-if (progn (setf x (incf i))
#'identity)
(progn (setf y (incf i))
'(nil nil a b nil c d))
:key (progn (setf z (incf i)) #'identity)
:key (progn (setf w (incf i)) #'not))
i x y z w))
(a b nil c d) 4 1 2 3 4)
;;; Keyword tests
(deftest member-if.keywords.1
......@@ -79,19 +105,19 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; member-if-not
(deftest member-if-not-1
(deftest member-if-not.1
(member-if-not #'listp nil)
nil)
(deftest member-if-not-2
(deftest member-if-not.2
(member-if-not #'(lambda (x) (eqt x 'a)) '(a 1 2 a 3 4))
(1 2 a 3 4))
(deftest member-if-not-3
(deftest member-if-not.3
(member-if-not #'(lambda (x) (not (eql x 12))) '(4 12 11 73 11) :key #'1+)
(11 73 11))
(deftest member-if-not-4
(deftest member-if-not.4
(let ((test-inputs
`(1 a 11.3121 11.31s3 1.123f5 -1 0
13.13122d34 581.131e-10
......@@ -108,10 +134,35 @@
test-inputs)))
nil)
(deftest member-if-not-5
(deftest member-if-not.5
(member-if-not #'not '(1 2 3 4 5) :key #'evenp)
(2 3 4 5))
;;; Order of evaluation tests
(deftest member-if-not.6
(let ((i 0) x y)
(values
(member-if-not (progn (setf x (incf i))
#'not)
(progn (setf y (incf i))
'(nil nil a b nil c d)))
i x y))
(a b nil c d) 2 1 2)
(deftest member-if-not.7
(let ((i 0) x y z w)
(values
(member-if-not (progn (setf x (incf i))
#'not)
(progn (setf y (incf i))
'(nil nil a b nil c d))
:key (progn (setf z (incf i)) #'identity)
:key (progn (setf w (incf i)) #'not))
i x y z w))
(a b nil c d) 4 1 2 3 4)
;;; Keyword tests
(deftest member-if-not.keywords.1
......
......@@ -10,11 +10,11 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; mapc
(deftest mapc-1
(deftest mapc.1
(mapc #'list nil)
nil)
(deftest mapc-2
(deftest mapc.2
(let ((x 0))
(let ((result
(mapc #'(lambda (y) (incf x y))
......@@ -22,7 +22,7 @@
(list result x)))
((1 2 3 4) 10))
(deftest mapc-3
(deftest mapc.3
(let ((x 0))
(list
(mapc #'(lambda (y z) (declare (ignore y z)) (incf x))
......@@ -31,7 +31,7 @@
x))
((a a a a a) 5))
(deftest mapc-4
(deftest mapc.4
(let ((x 0))
(list
(mapc #'(lambda (y z) (declare (ignore y z)) (incf x))
......@@ -40,7 +40,7 @@
x))
((a a a a a) 5))
(deftest mapc-5
(deftest mapc.5
(let ((x 0))
(list
(mapc #'(lambda (y z) (declare (ignore y z)) (incf x))
......@@ -49,21 +49,33 @@
x))
((a a a a a) 3))
(defvar *mapc-6-var* nil)
(defun mapc-6-fun (x)
(push x *mapc-6-var*)
(defvar *mapc.6-var* nil)
(defun mapc.6-fun (x)
(push x *mapc.6-var*)
x)
(deftest mapc-6
(deftest mapc.6
(let* ((x (copy-list '(a b c d e f g h)))
(xcopy (make-scaffold-copy x)))
(setf *mapc-6-var* nil)
(let ((result (mapc 'mapc-6-fun x)))
(setf *mapc.6-var* nil)
(let ((result (mapc 'mapc.6-fun x)))
(and (check-scaffold-copy x xcopy)
(eqt result x)
*mapc-6-var*)))
*mapc.6-var*)))
(h g f e d c b a))
(deftest mapc.7
(let ((i 0) x y z)
(values
(mapc (progn (setf x (incf i))
#'list)
(progn (setf y (incf i))
'(a b c))
(progn (setf z (incf i))
'(1 2 3)))
i x y z))
(a b c) 3 1 2 3)
(deftest mapc.error.1
(classify-error (mapc #'identity 1))
type-error)
......@@ -83,11 +95,11 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; mapcar
(deftest mapcar-1
(deftest mapcar.1
(mapcar #'1+ nil)
nil)
(deftest mapcar-2
(deftest mapcar.2
(let* ((x (copy-list '(1 2 3 4)))
(xcopy (make-scaffold-copy x)))
(let ((result (mapcar #'1+ x)))
......@@ -95,7 +107,7 @@
result)))
(2 3 4 5))
(deftest mapcar-3
(deftest mapcar.3
(let* ((n 0)
(x (copy-list '(a b c d)))
(xcopy (make-scaffold-copy x)))
......@@ -106,7 +118,7 @@
result)))
(1 2 3 4))
(deftest mapcar-4
(deftest mapcar.4
(let* ((n 0)
(x (copy-list '(a b c d)))
(xcopy (make-scaffold-copy x))
......@@ -120,7 +132,7 @@
(list result n)))
((1 2 3 4) 4))
(deftest mapcar-5
(deftest mapcar.5
(let* ((n 0)
(x (copy-list '(a b c d)))
(xcopy (make-scaffold-copy x))
......@@ -134,15 +146,28 @@
(list result n)))
((1 2 3 4) 4))
(deftest mapcar-6
(deftest mapcar.6
(let* ((x (copy-list '(a b c d e f g h)))
(xcopy (make-scaffold-copy x)))
(setf *mapc-6-var* nil)
(let ((result (mapcar 'mapc-6-fun x)))
(setf *mapc.6-var* nil)
(let ((result (mapcar 'mapc.6-fun x)))
(and (check-scaffold-copy x xcopy)
(list *mapc-6-var* result))))
(list *mapc.6-var* result))))
((h g f e d c b a) (a b c d e f g h)))
(deftest mapcar.7
(let ((i 0) x y z)
(values
(mapcar (progn (setf x (incf i))
#'list)
(progn (setf y (incf i))
'(a b c))
(progn (setf z (incf i))
'(1 2 3)))
i x y z))
((a 1) (b 2) (c 3))
3 1 2 3)
(deftest mapcar.error.1
(classify-error (mapcar #'identity 1))
type-error)
......@@ -207,25 +232,38 @@
(a b a c b a d c b a))
(deftest mapcan.7
(let ((i 0) x y z)
(values
(mapcan (progn (setf x (incf i))
#'list)
(progn (setf y (incf i))
'(a b c))
(progn (setf z (incf i))
'(1 2 3)))
i x y z))
(a 1 b 2 c 3)
3 1 2 3)
(deftest mapcan.8
(mapcan #'(lambda (x y) (make-list y :initial-element x))
(copy-list '(a b c d))
(copy-list '(1 2 3 4 5 6)))
(a b b c c c d d d d))
(deftest mapcan.8
(deftest mapcan.9
(mapcan #'(lambda (x y) (make-list y :initial-element x))
(copy-list '(a b c d e f))
(copy-list '(1 2 3 4)))
(a b b c c c d d d d))
(deftest mapcan.9
(deftest mapcan.10
(mapcan #'list
(copy-list '(a b c d))
(copy-list '(1 2 3 4))
nil)
nil)
(deftest mapcan.10
(deftest mapcan.11
(mapcan (constantly 1) (list 'a))
1)
......@@ -248,11 +286,11 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; mapl
(deftest mapl-1
(deftest mapl.1
(mapl #'list nil)
nil)
(deftest mapl-2
(deftest mapl.2
(let* ((a nil)
(x (copy-list '(a b c)))
(xcopy (make-scaffold-copy x))
......@@ -265,7 +303,7 @@
a))
((c) (b c) (a b c)))
(deftest mapl-3
(deftest mapl.3
(let* ((a nil)
(x (copy-list '(a b c d)))
(y (copy-list '(1 2 3 4)))
......@@ -285,7 +323,7 @@
((d 4) (c 3) (d 4) (b 2) (c 3) (d 4)
(a 1) (b 2) (c 3) (d 4)))
(deftest mapl-4
(deftest mapl.4
(let* ((a nil)
(x (copy-list '(a b c d)))
(y (copy-list '(1 2 3 4 5 6 7 8)))
......@@ -305,7 +343,7 @@
((d 4) (c 3) (d 4) (b 2) (c 3) (d 4)
(a 1) (b 2) (c 3) (d 4)))
(deftest mapl-5
(deftest mapl.5
(let* ((a nil)
(x (copy-list '(a b c d e f g)))
(y (copy-list '(1 2 3 4)))
......@@ -325,6 +363,21 @@
((d 4) (c 3) (d 4) (b 2) (c 3) (d 4)
(a 1) (b 2) (c 3) (d 4)))
(deftest mapl.6
(let ((i 0) x y z)
(values
(mapl (progn
(setf x (incf i))
(constantly nil))
(progn
(setf y (incf i))
'(a b c))
(progn
(setf z (incf i))
'(1 2 3)))
i x y z))
(a b c) 3 1 2 3)
(deftest mapl.error.1
(classify-error (mapl #'identity 1))
type-error)
......@@ -344,11 +397,11 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; maplist
(deftest maplist-1
(deftest maplist.1
(maplist #'list nil)
nil)
(deftest maplist-2
(deftest maplist.2
(let* ((x (copy-list '(a b c)))
(xcopy (make-scaffold-copy x))
(result (maplist #'identity x)))
......@@ -356,7 +409,7 @@
result))
((a b c) (b c) (c)))
(deftest maplist-3
(deftest maplist.3
(let* ((x (copy-list '(a b c d)))
(y (copy-list '(1 2 3 4)))
(xcopy (make-scaffold-copy x))
......@@ -372,7 +425,7 @@
(c d 3 4)
(d 4)))
(deftest maplist-4
(deftest maplist.4
(let* ((x (copy-list '(a b c d)))
(y (copy-list '(1 2 3 4 5)))
(xcopy (make-scaffold-copy x))
......@@ -388,7 +441,7 @@
(c d 3 4 5)
(d 4 5)))
(deftest maplist-5
(deftest maplist.5
(let* ((x (copy-list '(a b c d e)))
(y (copy-list '(1 2 3 4)))
(xcopy (make-scaffold-copy x))
......@@ -404,17 +457,33 @@
(c d e 3 4)
(d e 4)))
(deftest maplist-6
(deftest maplist.6
(maplist 'append '(a b c) '(1 2 3))
((a b c 1 2 3) (b c 2 3) (c 3)))
(deftest maplist-7
(deftest maplist.7
(maplist #'(lambda (x y) (nth (car x) y))
'(0 1 0 1 0 1 0)
'(a b c d e f g)
)
(a c c e e g g))
(deftest maplist.8
(let ((i 0) x y z)
(values
(maplist
(progn
(setf x (incf i))
#'(lambda (x y) (declare (ignore x)) (car y)))
(progn
(setf y (incf i))
'(a b c))
(progn
(setf z (incf i))
'(1 2 3)))
i x y z))
(1 2 3) 3 1 2 3)
(deftest maplist.error.1
(classify-error (maplist #'identity 'a))
type-error)
......@@ -444,7 +513,7 @@
type-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; mapcan
;;; mapcon
(deftest mapcon.1
(mapcon #'(lambda (x) (append '(a) x nil)) nil)
......@@ -479,6 +548,19 @@
(mapcon (constantly 1) (list 'a))
1)
(deftest mapcon.5
(let ((i 0) x y z)
(values
(mapcon (progn (setf x (incf i))
#'(lambda (x y) (list (car x) (car y))))
(progn (setf y (incf i))
'(a b c))
(progn (setf z (incf i))
'(1 2 3)))
i x y z))
(a 1 b 2 c 3)
3 1 2 3)
(deftest mapcon.error.1
(classify-error (mapcon #'identity 1))
type-error)
......
......@@ -10,36 +10,46 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; acons
(deftest acons-1
(let* ((x (copy-tree '((c . d) (e . f))))
(xcopy (make-scaffold-copy x))
(result (acons 'a 'b x)))
(and
(check-scaffold-copy x xcopy)
(eqt (cdr result) x)
result))
(deftest acons.1
(let* ((x (copy-tree '((c . d) (e . f))))
(xcopy (make-scaffold-copy x))
(result (acons 'a 'b x)))
(and
(check-scaffold-copy x xcopy)
(eqt (cdr result) x)
result))
((a . b) (c . d) (e . f)))
(deftest acons-2
(acons 'a 'b nil)
(deftest acons.2
(acons 'a 'b nil)
((a . b)))
(deftest acons-3
(acons 'a 'b 'c)
(deftest acons.3
(acons 'a 'b 'c)
((a . b) . c))
(deftest acons-4
(acons '((a b)) '(((c d) e) f) '((1 . 2)))
(deftest acons.4
(acons '((a b)) '(((c d) e) f) '((1 . 2)))
(( ((a b)) . (((c d) e) f)) (1 . 2)))
(deftest acons-5
(acons "ancd" 1.143 nil)
(deftest acons.5
(acons "ancd" 1.143 nil)
(("ancd" . 1.143)))
(deftest acons-6
(acons #\R :foo :bar)
(deftest acons.6
(acons #\R :foo :bar)
((#\R . :foo) . :bar))
(deftest acons.7
(let ((i 0) x y z)
(values
(acons (progn (setf x (incf i)) 'a)
(progn (setf y (incf i)) 'b)
(progn (setf z (incf i)) '((c . d))))
i x y z))
((a . b)(c . d))
3 1 2 3)
(deftest acons.error.1
(classify-error (acons))
program-error)
......@@ -59,31 +69,31 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; assoc
(deftest assoc-1
(deftest assoc.1
(assoc nil nil)
nil)
(deftest assoc-2
(deftest assoc.2
(assoc nil '(nil))
nil)
(deftest assoc-3
(deftest assoc.3
(assoc nil '(nil (nil . 2) (a . b)))
(nil . 2))
(deftest assoc-4
(deftest assoc.4
(assoc nil '((a . b) (c . d)))
nil)
(deftest assoc-5
(deftest assoc.5
(assoc 'a '((a . b)))
(a . b))
(deftest assoc-6
(deftest assoc.6
(assoc 'a '((:a . b) (#:a . c) (a . d) (a . e) (z . f)))
(a . d))
(deftest assoc-7
(deftest assoc.7
(let* ((x (copy-tree '((a . b) (b . c) (c . d))))
(xcopy (make-scaffold-copy x))
(result (assoc 'b x)))
......@@ -92,85 +102,85 @@
(check-scaffold-copy x xcopy)))
t)
(deftest assoc-8
(deftest assoc.8
(assoc 1 '((0 . a) (1 . b) (2 . c)))
(1 . b))
(deftest assoc-9
(deftest assoc.9
(assoc (copy-seq "abc")
'((abc . 1) ("abc" . 2) ("abc" . 3)))
nil)
(deftest assoc-10
(deftest assoc.10
(assoc (copy-list '(a)) (copy-tree '(((a) b) ((a) (c)))))
nil)
(deftest assoc-11
(deftest assoc.11
(let ((x (list 'a 'b)))
(assoc x `(((a b) c) (,x . d) (,x . e) ((a b) 1))))
((a b) . d))
(deftest assoc-12
(deftest assoc.12
(assoc #\e '(("abefd" . 1) ("aevgd" . 2) ("edada" . 3))
:key #'(lambda (x) (char x 1)))
("aevgd" . 2))
(deftest assoc-13
(deftest assoc.13
(assoc nil '(((a) . b) ( nil . c ) ((nil) . d))
:key #'car)
(nil . c))
(deftest assoc-14
(deftest assoc.14
(assoc (copy-seq "abc")
'((abc . 1) ("abc" . 2) ("abc" . 3))
:test #'equal)
("abc" . 2))
(deftest assoc-15
(deftest assoc.15
(assoc (copy-seq "abc")
'((abc . 1) ("abc" . 2) ("abc" . 3))
:test #'equalp)
("abc" . 2))
(deftest assoc-16
(deftest assoc.16
(assoc (copy-list '(a)) (copy-tree '(((a) b) ((a) (c))))
:test #'equal)
((a) b))
(deftest assoc-17
(deftest assoc.17
(assoc (copy-seq "abc")
'((abc . 1) (a . a) (b . b) ("abc" . 2) ("abc" . 3))
:test-not (complement #'equalp))
("abc" . 2))
(deftest assoc-18
(deftest assoc.18
(assoc 'a '((a . d)(b . c)) :test-not #'eq)
(b . c))
(deftest assoc-19
(deftest assoc.19
(assoc 'a '((a . d)(b . c)) :test (complement #'eq))
(b . c))
(deftest assoc-20
(deftest assoc.20
(assoc "a" '(("" . 1) (a . 2) ("A" . 6) ("a" . 3) ("A" . 5))
:key #'(lambda (x) (and (stringp x) (string-downcase x)))
:test #'equal)
("A" . 6))
(deftest assoc-21
(deftest assoc.21
(assoc "a" '(("" . 1) (a . 2) ("A" . 6) ("a" . 3) ("A" . 5))
:key #'(lambda (x) (and (stringp x) x))
:test #'equal)
("a" . 3))
(deftest assoc-22
(deftest assoc.22
(assoc "a" '(("" . 1) (a . 2) ("A" . 6) ("a" . 3) ("A" . 5))
:key #'(lambda (x) (and (stringp x) (string-downcase x)))
:test-not (complement #'equal))
("A" . 6))
(deftest assoc-23
(deftest assoc.23
(assoc "a" '(("" . 1) (a . 2) ("A" . 6) ("a" . 3) ("A" . 5))
:key #'(lambda (x) (and (stringp x) x))
:test-not (complement #'equal))
......@@ -179,14 +189,14 @@
;; Check that it works when test returns a true value
;; other than T
(deftest assoc-24
(deftest assoc.24
(assoc 'a '((b . 1) (a . 2) (c . 3))
:test #'(lambda (x y) (and (eqt x y) 'matched)))
(a . 2))
;; Check that the order of the arguments to test is correct