Commit 628bce31 authored by pfdietz's avatar pfdietz

More order-of-argument-evaluation tests.

parent 263b709a
This diff is collapsed.
......@@ -10,133 +10,133 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; nunion
(deftest nunion-1
(deftest nunion.1
(nunion nil nil)
nil)
(deftest nunion-2
(deftest nunion.2
(nunion-with-copy (list 'a) nil)
(a))
(deftest nunion-3
(deftest nunion.3
(nunion-with-copy (list 'a) (list 'a))
(a))
(deftest nunion-4
(deftest nunion.4
(nunion-with-copy (list 1) (list 1))
(1))
(deftest nunion-5
(deftest nunion.5
(let ((x (list 'a 'b)))
(nunion-with-copy (list x) (list x)))
((a b)))
(deftest nunion-6
(deftest nunion.6
(let ((x '(a b c d e f))
(y '(z c y a v b)))
(let ((result (nunion-with-copy x y)))
(check-union x y result)))
t)
(deftest nunion-6-a
(deftest nunion.6-a
(let ((x '(a b c d e f))
(y '(z c y a v b)))
(let ((result (nunion-with-copy x y :test #'eq)))
(check-union x y result)))
t)
(deftest nunion-7
(deftest nunion.7
(let ((x '(a b c d e f))
(y '(z c y a v b)))
(let ((result (nunion-with-copy x y :test #'eql)))
(check-union x y result)))
t)
(deftest nunion-8
(deftest nunion.8
(let ((x '(a b c d e f))
(y '(z c y a v b)))
(let ((result (nunion-with-copy x y :test #'equal)))
(check-union x y result)))
t)
(deftest nunion-9
(deftest nunion.9
(let ((x '(a b c d e f))
(y '(z c y a v b)))
(let ((result (nunion-with-copy x y :test-not (complement #'eql))))
(check-union x y result)))
t)
(deftest nunion-10
(deftest nunion.10
(let ((x '(a b c d e f))
(y '(z c y a v b)))
(let ((result (nunion-with-copy x y :test-not (complement #'equal))))
(check-union x y result)))
t)
(deftest nunion-11
(deftest nunion.11
(let ((x '(a b c d e f))
(y '(z c y a v b)))
(let ((result (nunion-with-copy x y :test-not (complement #'eq))))
(check-union x y result)))
t)
(deftest nunion-12
(deftest nunion.12
(let ((x '(1 2 3 4 5 6 7))
(y '(10 19 5 3 17 1001 2)))
(let ((result (nunion-with-copy x y)))
(check-union x y result)))
t)
(deftest nunion-13
(deftest nunion.13
(let ((x '(1 2 3 4 5 6 7))
(y '(10 19 5 3 17 1001 2)))
(let ((result (nunion-with-copy x y :test #'equal)))
(check-union x y result)))
t)
(deftest nunion-14
(deftest nunion.14
(let ((x '(1 2 3 4 5 6 7))
(y '(10 19 5 3 17 1001 2)))
(let ((result (nunion-with-copy x y :test #'eql)))
(check-union x y result)))
t)
(deftest nunion-15
(deftest nunion.15
(let ((x '(1 2 3 4 5 6 7))
(y '(10 19 5 3 17 1001 2)))
(let ((result (nunion-with-copy x y :test-not (complement #'equal))))
(check-union x y result)))
t)
(deftest nunion-16
(deftest nunion.16
(let ((x '(1 2 3 4 5 6 7))
(y '(10 19 5 3 17 1001 2)))
(let ((result (nunion-with-copy x y :test-not (complement #'eql))))
(check-union x y result)))
t)
(deftest nunion-17
(deftest nunion.17
(let ((x '(1 2 3 4 5 6 7))
(y '(10 19 5 3 17 1001 2)))
(let ((result (nunion-with-copy-and-key x y #'1+)))
(check-union x y result)))
t)
(deftest nunion-18
(deftest nunion.18
(let ((x '(1 2 3 4 5 6 7))
(y '(10 19 5 3 17 1001 2)))
(let ((result (nunion-with-copy-and-key x y #'1+ :test #'equal)))
(check-union x y result)))
t)
(deftest nunion-19
(deftest nunion.19
(let ((x '(1 2 3 4 5 6 7))
(y '(10 19 5 3 17 1001 2)))
(let ((result (nunion-with-copy-and-key x y #'1+ :test #'eql)))
(check-union x y result)))
t)
(deftest nunion-20
(deftest nunion.20
(let ((x '(1 2 3 4 5 6 7))
(y '(10 19 5 3 17 1001 2)))
(let ((result (nunion-with-copy-and-key x y #'1+
......@@ -144,7 +144,7 @@
(check-union x y result)))
t)
(deftest nunion-21
(deftest nunion.21
(let ((x '(1 2 3 4 5 6 7))
(y '(10 19 5 3 17 1001 2)))
(let ((result (nunion-with-copy-and-key x y #'1+
......@@ -152,14 +152,14 @@
(check-union x y result)))
t)
(deftest nunion-22
(deftest nunion.22
(let ((x '(1 2 3 4 5 6 7))
(y '(10 19 5 3 17 1001 2)))
(let ((result (nunion-with-copy-and-key x y nil)))
(check-union x y result)))
t)
(deftest nunion-23
(deftest nunion.23
(let ((x '(1 2 3 4 5 6 7))
(y '(10 19 5 3 17 1001 2)))
(let ((result (nunion-with-copy-and-key x y '1+)))
......@@ -168,11 +168,11 @@
;; Do large numbers of random nunions
(deftest nunion-24
(deftest nunion.24
(do-random-nunions 100 100 200)
nil)
(deftest nunion-25
(deftest nunion.25
(let ((x (shuffle '(1 4 6 10 45 101)))
(y '(102 5 2 11 44 6)))
(let ((result (nunion-with-copy x y
......@@ -187,7 +187,7 @@
;; Check that nunion uses eql, not equal or eq
(deftest nunion-26
(deftest nunion.26
(let ((x 1000)
(y 1000))
(loop
......@@ -203,7 +203,7 @@
1))))
t)
(deftest nunion-27
(deftest nunion.27
(nunion-with-copy (list (copy-seq "aa"))
(list (copy-seq "aa")))
("aa" "aa"))
......@@ -212,7 +212,7 @@
;; Check that nunion does not reverse the arguments to :test, :test-not
(deftest nunion-28
(deftest nunion.28
(block fail
(sort
(nunion-with-copy
......@@ -224,7 +224,7 @@
#'<))
(1 2 3 4 5 6))
(deftest nunion-29
(deftest nunion.29
(block fail
(sort
(nunion-with-copy-and-key
......@@ -237,7 +237,7 @@
#'<))
(1 2 3 4 5 6))
(deftest nunion-30
(deftest nunion.30
(block fail
(sort
(nunion-with-copy
......@@ -250,7 +250,7 @@
#'<))
(1 2 3 4 5 6))
(deftest nunion-31
(deftest nunion.31
(block fail
(sort
(nunion-with-copy-and-key
......@@ -263,6 +263,46 @@
#'<))
(1 2 3 4 5 6))
;;; Order of evaluation tests
(deftest nunion.32
(let ((i 0) x y)
(values
(sort
(nunion (progn (setf x (incf i)) (copy-list '(1 3 5)))
(progn (setf y (incf i)) (copy-list '(2 5 8))))
#'<)
i x y))
(1 2 3 5 8)
2 1 2)
(deftest nunion.33
(let ((i 0) x y z w)
(values
(sort
(nunion (progn (setf x (incf i)) (copy-list '(1 3 5)))
(progn (setf y (incf i)) (copy-list '(2 5 8)))
:test (progn (setf z (incf i)) #'eql)
:key (progn (setf w (incf i)) #'identity))
#'<)
i x y z w))
(1 2 3 5 8)
4 1 2 3 4)
(deftest nunion.34
(let ((i 0) x y z w)
(values
(sort
(nunion (progn (setf x (incf i)) (copy-list '(1 3 5)))
(progn (setf y (incf i)) (copy-list '(2 5 8)))
:key (progn (setf z (incf i)) #'identity)
:test (progn (setf w (incf i)) #'eql))
#'<)
i x y z w))
(1 2 3 5 8)
4 1 2 3 4)
;;; Keyword tests
(deftest nunion.allow-other-keys.1
......
This diff is collapsed.
This diff is collapsed.
......@@ -12,58 +12,58 @@
(defvar cons-test-24-var '(78 "z" (8 9)))
(deftest subsetp-1
(subsetp-with-check (copy-tree '(78)) cons-test-24-var)
(deftest subsetp.1
(subsetp-with-check (copy-tree '(78)) cons-test-24-var)
t)
(deftest subsetp-2
(subsetp-with-check (copy-tree '((8 9))) cons-test-24-var)
(deftest subsetp.2
(subsetp-with-check (copy-tree '((8 9))) cons-test-24-var)
nil)
(deftest subsetp-3
(subsetp-with-check (copy-tree '((8 9)))
cons-test-24-var :test 'equal)
(deftest subsetp.3
(subsetp-with-check (copy-tree '((8 9)))
cons-test-24-var :test 'equal)
t)
(deftest subsetp-4
(subsetp-with-check (list 78 (copy-seq "Z")) cons-test-24-var
:test #'equalp)
(deftest subsetp.4
(subsetp-with-check (list 78 (copy-seq "Z")) cons-test-24-var
:test #'equalp)
t)
(deftest subsetp-5
(subsetp-with-check (list 1) (list 0 2 3 4)
:key #'(lambda (i) (floor (/ i 2))))
(deftest subsetp.5
(subsetp-with-check (list 1) (list 0 2 3 4)
:key #'(lambda (i) (floor (/ i 2))))
t)
(deftest subsetp-6
(subsetp-with-check (list 1 6) (list 0 2 3 4)
:key #'(lambda (i) (floor (/ i 2))))
(deftest subsetp.6
(subsetp-with-check (list 1 6) (list 0 2 3 4)
:key #'(lambda (i) (floor (/ i 2))))
nil)
(deftest subsetp-7
(subsetp-with-check (list '(a . 10) '(b . 20) '(c . 30))
(list '(z . c) '(a . y) '(b . 100) '(e . f)
'(c . foo))
:key #'car)
(deftest subsetp.7
(subsetp-with-check (list '(a . 10) '(b . 20) '(c . 30))
(list '(z . c) '(a . y) '(b . 100) '(e . f)
'(c . foo))
:key #'car)
t)
(deftest subsetp-8
(subsetp-with-check (copy-tree '((a . 10) (b . 20) (c . 30)))
(copy-tree '((z . c) (a . y) (b . 100) (e . f)
(c . foo)))
:key 'car)
(deftest subsetp.8
(subsetp-with-check (copy-tree '((a . 10) (b . 20) (c . 30)))
(copy-tree '((z . c) (a . y) (b . 100) (e . f)
(c . foo)))
:key 'car)
t)
(deftest subsetp-9
(subsetp-with-check (list 'a 'b 'c)
(copy-tree
(list '(z . c) '(a . y) '(b . 100) '(e . f)
'(c . foo)))
:test #'(lambda (e1 e2)
(eqt e1 (car e2))))
(deftest subsetp.9
(subsetp-with-check (list 'a 'b 'c)
(copy-tree
(list '(z . c) '(a . y) '(b . 100) '(e . f)
'(c . foo)))
:test #'(lambda (e1 e2)
(eqt e1 (car e2))))
t)
(deftest subsetp-10
(deftest subsetp.10
(subsetp-with-check (list 'a 'b 'c)
(copy-tree
(list '(z . c) '(a . y) '(b . 100) '(e . f)
......@@ -73,58 +73,96 @@
:key nil)
t)
(deftest subsetp-11
(subsetp-with-check (list 'a 'b 'c)
(copy-tree
(list '(z . c) '(a . y) '(b . 100) '(e . f)
'(c . foo)))
:test-not #'(lambda (e1 e2)
(not (eqt e1 (car e2)))))
(deftest subsetp.11
(subsetp-with-check (list 'a 'b 'c)
(copy-tree
(list '(z . c) '(a . y) '(b . 100) '(e . f)
'(c . foo)))
:test-not #'(lambda (e1 e2)
(not (eqt e1 (car e2)))))
t)
;; Check that it maintains order of arguments
(deftest subsetp-12
(block fail
(subsetp-with-check
(list 1 2 3)
(list 4 5 6)
:test #'(lambda (x y)
(when (< y x) (return-from fail 'fail))
t)))
t)
(deftest subsetp-13
(block fail
(subsetp-with-check
(list 1 2 3)
(list 4 5 6)
:key #'identity
:test #'(lambda (x y)
(when (< y x) (return-from fail 'fail))
t)))
t)
(deftest subsetp-14
(block fail
(subsetp-with-check
(list 1 2 3)
(list 4 5 6)
:test-not #'(lambda (x y)
(when (< y x) (return-from fail 'fail))
nil)))
t)
(deftest subsetp-15
(block fail
(subsetp-with-check
(list 1 2 3)
(list 4 5 6)
:key #'identity
:test-not #'(lambda (x y)
(when (< y x) (return-from fail 'fail))
nil)))
t)
(deftest subsetp.12
(block fail
(subsetp-with-check
(list 1 2 3)
(list 4 5 6)
:test #'(lambda (x y)
(when (< y x) (return-from fail 'fail))
t)))
t)
(deftest subsetp.13
(block fail
(subsetp-with-check
(list 1 2 3)
(list 4 5 6)
:key #'identity
:test #'(lambda (x y)
(when (< y x) (return-from fail 'fail))
t)))
t)
(deftest subsetp.14
(block fail
(subsetp-with-check
(list 1 2 3)
(list 4 5 6)
:test-not #'(lambda (x y)
(when (< y x) (return-from fail 'fail))
nil)))
t)
(deftest subsetp.15
(block fail
(subsetp-with-check
(list 1 2 3)
(list 4 5 6)
:key #'identity
:test-not #'(lambda (x y)
(when (< y x) (return-from fail 'fail))
nil)))
t)
;;; Order of argument evaluation tests
(deftest subsetp.16
(let ((i 0) x y)
(values
(notnot (subsetp (progn (setf x (incf i))
'(a b c))
(progn (setf y (incf i))
'(a b c d))))
i x y))
t 2 1 2)
(deftest subsetp.17
(let ((i 0) x y z w)
(values
(notnot (subsetp (progn (setf x (incf i))
'(a b c))
(progn (setf y (incf i))
'(a b c d))
:test (progn (setf z (incf i)) #'eql)
:key (progn (setf w (incf i)) nil)))
i x y z w))
t 4 1 2 3 4)
(deftest subsetp.18
(let ((i 0) x y z w)
(values
(notnot (subsetp (progn (setf x (incf i))
'(a b c))
(progn (setf y (incf i))
'(a b c d))
:key (progn (setf z (incf i)) nil)
:test (progn (setf w (incf i)) #'eql)))
i x y z w))
t 4 1 2 3 4)
;;; Keyword tests
......
......@@ -418,6 +418,36 @@
(count-if-not #'%onep a :from-end t)))))
2 3 2 3)
;;; Argument order tests
(deftest count-if-not-order.1
(let ((i 0) c1 c2 c3 c4 c5 c6)
(values
(count-if-not
(progn (setf c1 (incf i)) #'null)
(progn (setf c2 (incf i)) '(a nil b c nil d e))
:start (progn (setf c3 (incf i)) 0)
:end (progn (setf c4 (incf i)) 3)
:key (progn (setf c5 (incf i)) #'not)
:from-end (progn (setf c6 (incf i)) nil)
)
i c1 c2 c3 c4 c5 c6))
1 6 1 2 3 4 5 6)
(deftest count-if-not-order.2
(let ((i 0) c1 c2 c3 c4 c5 c6)
(values
(count-if-not
(progn (setf c1 (incf i)) #'null)
(progn (setf c2 (incf i)) '(a nil b c nil d e))
:from-end (progn (setf c3 (incf i)) nil)
:key (progn (setf c4 (incf i)) #'not)
:end (progn (setf c5 (incf i)) 3)
:start (progn (setf c6 (incf i)) 0)
)
i c1 c2 c3 c4 c5 c6))
1 6 1 2 3 4 5 6)
;;; Keyword tests
(deftest count-if-not.keywords.1
......
......@@ -417,6 +417,35 @@
(count-if #'digit-char-p s :start 1 :end 2)))
3 3 2 2 1)
;;; Argument order tests
(deftest count-if-order.1
(let ((i 0) c1 c2 c3 c4 c5 c6)
(values
(count-if (progn (setf c1 (incf i)) #'null)
(progn (setf c2 (incf i)) '(a nil b c nil d e))
:start (progn (setf c3 (incf i)) 0)
:end (progn (setf c4 (incf i)) 3)
:key (progn (setf c5 (incf i)) #'identity)
:from-end (progn (setf c6 (incf i)) nil)
)
i c1 c2 c3 c4 c5 c6))
1 6 1 2 3 4 5 6)
(deftest count-if-order.2
(let ((i 0) c1 c2 c3 c4 c5 c6)
(values
(count-if (progn (setf c1 (incf i)) #'null)
(progn (setf c2 (incf i)) '(a nil b c nil d e))
:from-end (progn (setf c3 (incf i)) nil)
:key (progn (setf c4 (incf i)) #'identity)
:end (progn (setf c5 (incf i)) 3)
:start (progn (setf c6 (incf i)) 0)
)
i c1 c2 c3 c4 c5 c6))
1 6 1 2 3 4 5 6)
;;; Keyword tests
(deftest count-if.allow-other-keys.1
......
......@@ -486,6 +486,37 @@
:start 2 :end 5)
3)
;;; Argument order tests
(deftest count-order.1
(let ((i 0) c1 c2 c3 c4 c5 c6 c7)
(values
(count (progn (setf c1 (incf i)) nil)
(progn (setf c2 (incf i)) '(a nil b c nil d e))
:start (progn (setf c3 (incf i)) 0)
:end (progn (setf c4 (incf i)) 3)
:key (progn (setf c5 (incf i)) #'identity)
:from-end (progn (setf c6 (incf i)) nil)
:test (progn (setf c7 (incf i)) #'eql)
)
i c1 c2 c3 c4 c5 c6 c7))
1 7 1 2 3 4 5 6 7)
(deftest count-order.2
(let ((i 0) c1 c2 c3 c4 c5 c6 c7)
(values
(count (progn (setf c1 (incf i)) nil)
(progn (setf c2 (incf i)) '(a nil b c nil d e))
:test (progn (setf c3 (incf i)) #'eql)
:from-end (progn (setf c4 (incf i)) nil)
:key (progn (setf c5 (incf i)) #'identity)
:end (progn (setf c6 (incf i)) 3)
:start (progn (setf c7 (incf i)) 0)
)
i c1 c2 c3 c4 c5 c6 c7))
1 7 1 2 3 4 5 6 7)
;;; Keyword tests
(deftest count.allow-other-keys.1
......
......@@ -123,6 +123,25 @@
(elt x #\w)))
type-error)
(deftest elt.20
(let ((i 0) x y)
(values
(elt (progn (setf x (incf i)) '(a b c d e))
(progn (setf y (incf i)) 3))
i x y))
d 2 1 2)
(deftest elt.21
(let ((i 0) x y z)
(let ((a (make-array 1 :initial-element (list 'a 'b 'c 'd 'e))))
(values
(setf (elt (aref a (progn (setf x (incf i)) 0))
(progn (setf y (incf i)) 3))
(progn (setf z (incf i)) 'k))
(aref a 0)
i x y z)))
k (a b c k e) 3 1 2 3)
(deftest elt-v-1
(classify-error
(elt (make-array '(0)) 0))
......@@ -347,5 +366,3 @@
(deftest elt.error.3
(classify-error (elt nil 0 nil))
program-error)
......@@ -51,6 +51,13 @@
(eqlt #c(1 -2) (- #c(-1 2)))
t)
(deftest eql.12
(let ((i 0) x y)
(values
(eql (setf x (incf i)) (setf y (incf i)))
i x y))
nil 2 1 2)
(deftest eql.error.1
(classify-error (eql))
program-error)
......
......@@ -61,6 +61,13 @@
(equalt (copy-seq #*000110) (copy-seq #*000111))
nil)
(deftest equal.13
(let ((i 0) x y)
(values
(equal (setf x (incf i)) (setf y (incf i)))
i x y))
nil 2 1 2)
(deftest equal.error.1
(classify-error (equal))
program-error)
......
......@@ -27,6 +27,13 @@
(equalpt "abc" "abd")
nil)
(deftest equalp.5
(let ((i 0) x y)
(values
(equalp (setf x (incf i)) (setf y (incf i)))
i x y))
nil 2 1 2)
(deftest equalp.error.1
(classify-error (equalp))
program-error)
......
......@@ -78,6 +78,14 @@
(notnot-mv (every 'null '(nil nil nil nil)))
t)
(deftest every.17
(let ((i 0) x y)
(values
(every (progn (setf x (incf i)) #'null)
(progn (setf y (incf i)) '(nil nil a nil)))
i x y))
nil 2 1 2)
;;; Error cases
(deftest every.error.1
......
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