Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
ansi-test
ansi-test
Commits
2506e421
Commit
2506e421
authored
Feb 14, 2003
by
pfdietz
Browse files
More tests for order of evaluation of function arguments.
parent
fd8b1534
Changes
20
Hide whitespace changes
Inline
Side-by-side
ansi-tests/fill.lsp
View file @
2506e421
...
...
@@ -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)
ansi-tests/find-if-not.lsp
View file @
2506e421
...
...
@@ -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)
ansi-tests/find-if.lsp
View file @
2506e421
...
...
@@ -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)
ansi-tests/find.lsp
View file @
2506e421
...
...
@@ -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)
ansi-tests/funcall.lsp
View file @
2506e421
...
...
@@ -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
...
...
ansi-tests/make-array.lsp
View file @
2506e421
...
...
@@ -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)
ansi-tests/make-sequence.lsp
View file @
2506e421
...
...
@@ -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)
ansi-tests/make-string.lsp
View file @
2506e421
...
...
@@ -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)
ansi-tests/map-into.lsp
View file @
2506e421
...
...
@@ -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)
ansi-tests/map.lsp
View file @
2506e421
...
...
@@ -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)
ansi-tests/merge.lsp
View file @
2506e421
...
...
@@ -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
...
...
ansi-tests/mismatch.lsp
View file @
2506e421
...
...
@@ -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
...
...
ansi-tests/notany.lsp
View file @
2506e421
...
...
@@ -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
...
...
ansi-tests/notevery.lsp
View file @
2506e421
...
...
@@ -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
...
...
ansi-tests/nstring-capitalize.lsp
View file @
2506e421
...
...
@@ -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
...
...
ansi-tests/nstring-downcase.lsp
View file @
2506e421
...
...
@@ -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
...
...
ansi-tests/nstring-upcase.lsp
View file @
2506e421
...
...
@@ -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
...
...
ansi-tests/nsubstitute-if.lsp
View file @
2506e421
...
...
@@ -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
...
...
ansi-tests/svref.lsp
View file @
2506e421
...
...
@@ -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)
ansi-tests/typecase.lsp
View file @
2506e421
...
...
@@ -73,4 +73,4 @@
(deftest typecase.16
(typecase 'foo (otherwise :wrong) (symbol :right) (t :wrong2))
:right)
\ No newline at end of file
:right)
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment