Commit 2506e421 authored by pfdietz's avatar pfdietz

More tests for order of evaluation of function arguments.

parent fd8b1534
......@@ -477,3 +477,46 @@
(a a a a a))
;;; Tests of evaluation order
(deftest fill.order.1
(let ((i 0) x y (a (copy-seq #(a a a a))))
(values
(fill (progn (setf x (incf i)) a)
(progn (setf y (incf i)) 'z))
i x y))
#(z z z z) 2 1 2)
(deftest fill.order.2
(let ((i 0) x y z w (a (copy-seq #(a a a a))))
(values
(fill (progn (setf x (incf i)) a)
(progn (setf y (incf i)) 'z)
:start (progn (setf z (incf i)) 1)
:end (progn (setf w (incf i)) 3))
i x y z w))
#(a z z a) 4 1 2 3 4)
(deftest fill.order.3
(let ((i 0) x y z w (a (copy-seq #(a a a a))))
(values
(fill (progn (setf x (incf i)) a)
(progn (setf y (incf i)) 'z)
:end (progn (setf z (incf i)) 3)
:start (progn (setf w (incf i)) 1))
i x y z w))
#(a z z a) 4 1 2 3 4)
(deftest fill.order.4
(let ((i 0) x y z p q r s w (a (copy-seq #(a a a a))))
(values
(fill (progn (setf x (incf i)) a)
(progn (setf y (incf i)) 'z)
:end (progn (setf z (incf i)) 3)
:end (progn (setf p (incf i)) 1)
:end (progn (setf q (incf i)) 1)
:end (progn (setf r (incf i)) 1)
:start (progn (setf s (incf i)) 1)
:start (progn (setf w (incf i)) 0))
i x y z p q r s w))
#(a z z a) 8 1 2 3 4 5 6 7 8)
......@@ -556,3 +556,40 @@
(deftest find-if-not.error.11
(classify-error (locally (find-if-not #'null 'b) t))
type-error)
;;; Order of evaluation tests
(deftest find-if-not.order.1
(let ((i 0) x y)
(values
(find-if-not (progn (setf x (incf i)) #'null)
(progn (setf y (incf i)) '(nil nil nil a nil nil)))
i x y))
a 2 1 2)
(deftest find-if-not.order.2
(let ((i 0) a b c d e f g)
(values
(find-if-not (progn (setf a (incf i)) #'identity)
(progn (setf b (incf i)) '(nil nil nil a nil nil))
:start (progn (setf c (incf i)) 1)
:end (progn (setf d (incf i)) 4)
:from-end (setf e (incf i))
:key (progn (setf f (incf i)) #'null)
)
i a b c d e f))
a 6 1 2 3 4 5 6)
(deftest find-if-not.order.3
(let ((i 0) a b c d e f g)
(values
(find-if-not (progn (setf a (incf i)) #'identity)
(progn (setf b (incf i)) '(nil nil nil a nil nil))
:key (progn (setf c (incf i)) #'null)
:from-end (setf d (incf i))
:end (progn (setf e (incf i)) 4)
:start (progn (setf f (incf i)) 1)
)
i a b c d e f))
a 6 1 2 3 4 5 6)
......@@ -579,3 +579,40 @@
(deftest find-if.error.11
(classify-error (locally (find-if #'null 'b) t))
type-error)
;;; Order of evaluation tests
(deftest find-if.order.1
(let ((i 0) x y)
(values
(find-if (progn (setf x (incf i)) #'identity)
(progn (setf y (incf i)) '(nil nil nil a nil nil)))
i x y))
a 2 1 2)
(deftest find-if.order.2
(let ((i 0) a b c d e f g)
(values
(find-if (progn (setf a (incf i)) #'null)
(progn (setf b (incf i)) '(nil nil nil a nil nil))
:start (progn (setf c (incf i)) 1)
:end (progn (setf d (incf i)) 4)
:from-end (setf e (incf i))
:key (progn (setf f (incf i)) #'null)
)
i a b c d e f))
a 6 1 2 3 4 5 6)
(deftest find-if.order.3
(let ((i 0) a b c d e f g)
(values
(find-if (progn (setf a (incf i)) #'null)
(progn (setf b (incf i)) '(nil nil nil a nil nil))
:key (progn (setf c (incf i)) #'null)
:from-end (setf d (incf i))
:end (progn (setf e (incf i)) 4)
:start (progn (setf f (incf i)) 1)
)
i a b c d e f))
a 6 1 2 3 4 5 6)
......@@ -815,3 +815,39 @@
(deftest find.error.11
(classify-error (locally (find 'a 'b) t))
type-error)
;;; Order of evaluation tests
(deftest find.order.1
(let ((i 0) x y)
(values
(find (progn (setf x (incf i)) 'a)
(progn (setf y (incf i)) '(nil nil nil a nil nil)))
i x y))
a 2 1 2)
(deftest find.order.2
(let ((i 0) a b c d e f g)
(values
(find (progn (setf a (incf i)) nil)
(progn (setf b (incf i)) '(nil nil nil a nil nil))
:start (progn (setf c (incf i)) 1)
:end (progn (setf d (incf i)) 4)
:from-end (setf e (incf i))
:key (progn (setf f (incf i)) #'null)
)
i a b c d e f))
a 6 1 2 3 4 5 6)
(deftest find.order.3
(let ((i 0) a b c d e f g)
(values
(find (progn (setf a (incf i)) nil)
(progn (setf b (incf i)) '(nil nil nil a nil nil))
:key (progn (setf c (incf i)) #'null)
:from-end (setf d (incf i))
:end (progn (setf e (incf i)) 4)
:start (progn (setf f (incf i)) 1)
)
i a b c d e f))
a 6 1 2 3 4 5 6)
......@@ -51,6 +51,22 @@
(funcall #'foo))
)
(deftest funcall.order.1
(let ((i 0) a b)
(values
(funcall (progn (setf a (incf i)) #'car)
(progn (setf b (incf i)) '(x . y)))
i a b))
x 2 1 2)
(deftest funcall.order.2
(let ((i 0) a b c)
(values
(funcall (progn (setf a (incf i)) #'cons)
(progn (setf b (incf i)) 'x)
(progn (setf c (incf i)) 'y))
i a b c))
(x . y) 3 1 2 3)
;;; FUNCALL should throw an UNDEFINED-FUNCTION condition when
......
......@@ -642,3 +642,29 @@
(deftest make-array.error.6
(classify-error (make-array '(10) 1 2))
program-error)
;;; Order of evaluation tests
(deftest make-array.order.1
(let ((i 0) a b c d e)
(values
(make-array (progn (setf a (incf i)) 5)
:initial-element (progn (setf b (incf i)) 'a)
:fill-pointer (progn (setf c (incf i)) nil)
:displaced-to (progn (setf d (incf i)) nil)
:element-type (progn (setf e (incf i)) t)
)
i a b c d e))
#(a a a a a) 5 1 2 3 4 5)
(deftest make-array.order.2
(let ((i 0) a b c d e)
(values
(make-array (progn (setf a (incf i)) 5)
:element-type (progn (setf b (incf i)) t)
:displaced-to (progn (setf c (incf i)) nil)
:fill-pointer (progn (setf d (incf i)) nil)
:initial-element (progn (setf e (incf i)) 'a)
)
i a b c d e))
#(a a a a a) 5 1 2 3 4 5)
......@@ -249,3 +249,25 @@
(deftest make-sequence.error.14
(classify-error (locally (make-sequence 'symbol 10) t))
type-error)
;;; Order of execution tests
(deftest make-sequence.order.1
(let ((i 0) a b c)
(values
(make-sequence (progn (setf a (incf i)) 'list)
(progn (setf b (incf i)) 5)
:initial-element (progn (setf c (incf i)) 'a))
i a b c))
(a a a a a) 3 1 2 3)
(deftest make-sequence.order.2
(let ((i 0) a b c d e)
(values
(make-sequence (progn (setf a (incf i)) 'list)
(progn (setf b (incf i)) 5)
:allow-other-keys (setf c (incf i))
:initial-element (progn (setf d (incf i)) 'a)
:foo (setf e (incf i)))
i a b c d e))
(a a a a a) 5 1 2 3 4 5)
......@@ -131,3 +131,33 @@
(deftest make-string.error.6
(classify-error (make-string 10 :element-type))
program-error)
;;; Order of evaluation
(deftest make-string.order.1
(let ((i 0) a b)
(values
(make-string (progn (setf a (incf i)) 4)
:initial-element (progn (setf b (incf i)) #\a))
i a b))
"aaaa" 2 1 2)
(deftest make-string.order.2
(let ((i 0) a b c)
(values
(make-string (progn (setf a (incf i)) 4)
:initial-element (progn (setf b (incf i)) #\a)
:element-type (progn (setf c (incf i)) 'base-char))
i a b c))
"aaaa" 3 1 2 3)
(deftest make-string.order.3
(let ((i 0) a b c)
(values
(make-string (progn (setf a (incf i)) 4)
:element-type (progn (setf b (incf i)) 'base-char)
:initial-element (progn (setf c (incf i)) #\a))
i a b c))
"aaaa" 3 1 2 3)
......@@ -370,3 +370,24 @@
(deftest map-into.error.6
(classify-error (locally (map-into 'a #'(lambda () nil)) t))
type-error)
;;; Order of evaluation tests
(deftest map-into.order.1
(let ((i 0) a b c)
(values
(map-into (progn (setf a (incf i)) (list 1 2 3 4))
(progn (setf b (incf i)) #'identity)
(progn (setf c (incf i)) '(a b c d)))
i a b c))
(a b c d) 3 1 2 3)
(deftest map-into.order.2
(let ((i 0) a b c d)
(values
(map-into (progn (setf a (incf i)) (list 1 2 3 4))
(progn (setf b (incf i)) #'list)
(progn (setf c (incf i)) '(a b c d))
(progn (setf d (incf i)) '(e f g h)))
i a b c d))
((a e) (b f) (c g) (d h)) 4 1 2 3 4)
......@@ -231,3 +231,15 @@
:fill-pointer 8)))
(map 'list #'(lambda (x y) x) '(1 2 3 4 5 6 7 8 9 10) s1))
(1 2 3 4 5 6 7 8))
;;; Order of evaluation tests
(deftest map.order.1
(let ((i 0) a b c d)
(values
(map (progn (setf a (incf i)) 'list)
(progn (setf b (incf i)) #'list)
(progn (setf c (incf i)) '(a b c))
(progn (setf d (incf i)) '(b c d)))
i a b c d))
((a b)(b c)(c d)) 4 1 2 3 4)
......@@ -482,6 +482,18 @@
(deftest merge-bit-vector-length.1
(merge '(bit-vector 6) (list 0 1 1) (list 0 0 1) #'<)
#*000111)
;;; Order of evaluation
(deftest merge.order.1
(let ((i 0) a b c d)
(values
(merge (progn (setf a (incf i)) 'list)
(progn (setf b (incf i)) (list 2 5 6))
(progn (setf c (incf i)) (list 1 3 4))
(progn (setf d (incf i)) #'<))
i a b c d))
(1 2 3 4 5 6) 4 1 2 3 4)
;;; Tests of error situations
......
......@@ -631,6 +631,47 @@
:test (complement #'equal))
0)
;;; Order of evaluation
(deftest mismatch.order.1
(let ((i 0) a b)
(values
(mismatch (progn (setf a (incf i)) "abcd")
(progn (setf b (incf i)) "abzd"))
i a b))
2 2 1 2)
(deftest mismatch.order.2
(let ((i 0) a b c d e f g h j)
(values
(mismatch (progn (setf a (incf i)) "abcdef")
(progn (setf b (incf i)) "abcdef")
:key (progn (setf c (incf i)) #'identity)
:test (progn (setf d (incf i)) #'equal)
:start1 (progn (setf e (incf i)) 1)
:start2 (progn (setf f (incf i)) 1)
:end1 (progn (setf g (incf i)) 4)
:end2 (progn (setf h (incf i)) 4)
:from-end (setf j (incf i)))
i a b c d e f g h j))
nil 9 1 2 3 4 5 6 7 8 9)
(deftest mismatch.order.3
(let ((i 0) a b c d e f g h j)
(values
(mismatch (progn (setf a (incf i)) "abcdef")
(progn (setf b (incf i)) "abcdef")
:from-end (setf c (incf i))
:end2 (progn (setf d (incf i)) 4)
:end1 (progn (setf e (incf i)) 4)
:start2 (progn (setf f (incf i)) 1)
:start1 (progn (setf g (incf i)) 1)
:test (progn (setf h (incf i)) #'equal)
:key (progn (setf j (incf i)) #'identity))
i a b c d e f g h j))
nil 9 1 2 3 4 5 6 7 8 9)
;;; Error cases
(deftest mismatch.error.1
......
......@@ -79,6 +79,14 @@
(notany 'null '(1 2 3 nil 5))
nil)
(deftest notany.order.1
(let ((i 0) a b)
(values
(not (notany (progn (setf a (incf i)) 'null)
(progn (setf b (incf i)) '(a b c))))
i a b))
nil 2 1 2)
;;; Error cases
(deftest notany.error.1
......
......@@ -79,6 +79,14 @@
(notevery 'null '(nil nil nil nil))
nil)
(deftest notevery.order.1
(let ((i 0) a b)
(values
(notevery (progn (setf a (incf i)) #'identity)
(progn (setf b (incf i)) '(a b c d)))
i a b))
nil 2 1 2)
;;; Error cases
(deftest notevery.error.1
......
......@@ -60,6 +60,26 @@
("ABCDEF" "ABCDEF" "ABCDEf")
("ABCDEF" "ABCDEF")))
(deftest nstring-capitalize.order.1
(let ((i 0) a b c (s (copy-seq "abcdef")))
(values
(nstring-capitalize
(progn (setf a (incf i)) s)
:start (progn (setf b (incf i)) 1)
:end (progn (setf c (incf i)) 4))
i a b c))
"aBcdef" 3 1 2 3)
(deftest nstring-capitalize.order.2
(let ((i 0) a b c (s (copy-seq "abcdef")))
(values
(nstring-capitalize
(progn (setf a (incf i)) s)
:end (progn (setf b (incf i)) 4)
:start (progn (setf c (incf i)) 1))
i a b c))
"aBcdef" 3 1 2 3)
;;; Error cases
(deftest nstring-capitalize.error.1
......
......@@ -67,6 +67,26 @@
("abcde" "abcDe" "abcDE")
("abcde" "abcdE")))
(deftest nstring-downcase.order.1
(let ((i 0) a b c (s (copy-seq "ABCDEF")))
(values
(nstring-downcase
(progn (setf a (incf i)) s)
:start (progn (setf b (incf i)) 1)
:end (progn (setf c (incf i)) 4))
i a b c))
"AbcdEF" 3 1 2 3)
(deftest nstring-downcase.order.2
(let ((i 0) a b c (s (copy-seq "ABCDEF")))
(values
(nstring-downcase
(progn (setf a (incf i)) s)
:end (progn (setf b (incf i)) 4)
:start (progn (setf c (incf i)) 1))
i a b c))
"AbcdEF" 3 1 2 3)
;;; Error cases
(deftest nstring-downcase.error.1
......
......@@ -66,6 +66,26 @@
("abcde" "abcDe" "abcDE")
("abcde" "abcdE")))
(deftest nstring-upcase.order.1
(let ((i 0) a b c (s (copy-seq "abcdef")))
(values
(nstring-upcase
(progn (setf a (incf i)) s)
:start (progn (setf b (incf i)) 1)
:end (progn (setf c (incf i)) 4))
i a b c))
"aBCDef" 3 1 2 3)
(deftest nstring-upcase.order.2
(let ((i 0) a b c (s (copy-seq "abcdef")))
(values
(nstring-upcase
(progn (setf a (incf i)) s)
:end (progn (setf b (incf i)) 4)
:start (progn (setf c (incf i)) 1))
i a b c))
"aBCDef" 3 1 2 3)
;;; Error cases
......
......@@ -630,6 +630,41 @@
result)
#*01111)
(deftest nsubstitute-if.order.1
(let ((i 0) a b c d e f g h)
(values
(nsubstitute-if
(progn (setf a (incf i)) 'a)
(progn (setf b (incf i)) #'null)
(progn (setf c (incf i)) (list nil 1 2 nil 3 4 nil 5))
:count (progn (setf d (incf i)) 2)
:start (progn (setf e (incf i)) 0)
:end (progn (setf f (incf i)) 7)
:key (progn (setf g (incf i)) #'identity)
:from-end (setf h (incf i))
)
i a b c d e f g h))
(nil 1 2 a 3 4 a 5)
8 1 2 3 4 5 6 7 8)
(deftest nsubstitute-if.order.2
(let ((i 0) a b c d e f g h)
(values
(nsubstitute-if
(progn (setf a (incf i)) 'a)
(progn (setf b (incf i)) #'null)
(progn (setf c (incf i)) (list nil 1 2 nil 3 4 nil 5))
:from-end (setf h (incf i))
:key (progn (setf g (incf i)) #'identity)
:end (progn (setf f (incf i)) 7)
:start (progn (setf e (incf i)) 0)
:count (progn (setf d (incf i)) 2)
)
i a b c d e f g h))
(nil 1 2 a 3 4 a 5)
8 1 2 3 8 7 6 5 4)
;;; Keyword tests
(deftest nsubstitute-if.allow-other-keys.1
......
......@@ -28,3 +28,11 @@
(deftest svref.error.2
(classify-error (svref (vector 1)))
program-error)
(deftest svref.error.3
(classify-error (svref (vector 1) 0 0))
program-error)
(deftest svref.error.4
(classify-error (svref (vector 1) 0 nil))
program-error)
......@@ -73,4 +73,4 @@
(deftest typecase.16
(typecase 'foo (otherwise :wrong) (symbol :right) (t :wrong2))
:right)
\ No newline at end of file
:right)
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