Commit 236faa10 authored by pfdietz's avatar pfdietz

Added tests of check-type. Added more assert tests. Added checks for various...

Added tests of check-type.  Added more assert tests.  Added checks for various functions that the argument is evaluated only once.
parent 68c204ce
......@@ -25,6 +25,14 @@
(notnot (adjustable-array-p (make-array '(2 2 2 2) :adjustable t)))
t)
(deftest adjustable-array-p.order.1
(let ((i 0) x)
(values
(notnot (adjustable-array-p (progn (setf x (incf i))
(make-array '(5) :adjustable t))))
i x))
t 1 1)
;;; Error tests
(deftest adjustable-array-p.error.1
......
......@@ -32,11 +32,26 @@
nil)
(deftest and.8
(and (values 1 nil) (values nil 2))
nil 2)
(deftest and.9
(and (values nil t) t)
nil)
(deftest and.order.1
(let ((x 0))
(values (and nil (incf x))
x))
nil 0)
(deftest and.9
(and (values 1 nil) (values nil 2))
nil 2)
(deftest and.order.2
(let ((i 0) a b c d)
(values
(and (setf a (incf i))
(setf b (incf i))
(setf c (incf i))
(setf d (incf i)))
i a b c d))
4 4 1 2 3 4)
......@@ -48,7 +48,7 @@
;;; Order of argument evaluation
(deftest aref.8
(deftest aref.order.1
(let ((i 0) x y (a #(a b c d)))
(values
(aref (progn (setf x (incf i)) a)
......@@ -56,7 +56,7 @@
i x y))
c 2 1 2)
(deftest aref.9
(deftest aref.order.2
(let ((i 0) x y z (a #2a((a b c)(d e f))))
(values
(aref (progn (setf x (incf i)) a)
......@@ -123,7 +123,7 @@
0
#2a((1 0 1)(1 1 1)))
(deftest setf-aref.8
(deftest setf-aref.order.1
(let ((i 0) x y z (a (copy-seq #(a b c d))))
(values
(setf (aref (progn (setf x (incf i)) a)
......
......@@ -37,6 +37,14 @@
(array-dimension a 0))))
10 20)
(deftest array-dimension.order.1
(let ((i 0) a b)
(values
(array-dimension (progn (setf a (incf i)) #(a b c d))
(progn (setf b (incf i)) 0))
i a b))
4 2 1 2)
;;; Error tests
(deftest array-dimension.error.1
......
......@@ -94,6 +94,17 @@
(eqlt disp 0))))
t)
(deftest array-displacement.order.1
(let* ((a (make-array '(10)))
(b (make-array '(10) :displaced-to a))
(i 0))
(multiple-value-bind* (dt disp)
(array-displacement (progn (incf i) b))
(and (eql i 1)
(eqt a dt)
(eqlt disp 0))))
t)
;;; Error tests
(deftest array-displacement.error.1
......
......@@ -134,7 +134,7 @@
;;; Order of evaluation tests
(deftest array-in-bounds-p.24
(deftest array-in-bounds-p.order.1
(let ((x 0) y z)
(values
(array-in-bounds-p (progn (setf y (incf x))
......
......@@ -18,6 +18,13 @@
collect e)
nil)
(deftest array-rank.order.1
(let ((i 0) a)
(values
(array-rank (progn (setf a (incf i)) "abcd"))
i a))
1 1 1)
;;; Error tests
(deftest array-rank.error.1
......
......@@ -22,7 +22,7 @@
collect (array-row-major-index a i)))
(0 1 2 3 4))
(deftest array-row-major-index.4
(deftest array-row-major-index.order.1
(let ((x 0) y z
(a #(a b c d e f)))
(values
......@@ -30,7 +30,7 @@
(progn (setf y (incf x)) a)
(progn (setf z (incf x)) 0))
x y z))
0 2 1 2)
0 2 1 2)
;;; Error tests
......
......@@ -27,6 +27,13 @@
(array-total-size #2a((1 2 3)(4 5 6)(7 8 9)(a b c)))
12)
(deftest array-total-size.order.1
(let ((i 0) a)
(values
(array-total-size (progn (setf a (incf i)) #(a b c d)))
i a))
4 1 1)
;;; Error tests
(deftest array-total-size.error.1
......
......@@ -36,6 +36,13 @@
collect e)
nil)
(deftest arrayp.order.1
(let ((i 0) a)
(values
(arrayp (progn (setf a (incf i)) nil))
i a))
nil 1 1)
;;; Error tests
(deftest arrayp.error.1
......
......@@ -23,11 +23,21 @@
(setq x 17)
(let ((r (find-restart 'continue c)))
(when r (invoke-restart r))))))
(progn
(assert x)
x)))
(assert x)
x))
17)
(deftest assert.3a
(let ((x nil))
(handler-bind
((error #'(lambda (c)
(setq x 17)
(continue c))))
(assert x)
x))
17)
;;; I don't yet know how to test the interactive version of ASSERT
;;; that is normally invoked when places are given.
......@@ -49,4 +59,32 @@
"Vector x has value: ~A." x))
nil)
(deftest assert.7
(let ((x nil))
(handler-bind
((simple-error #'(lambda (c)
(setq x 17)
(continue c))))
(assert x () 'simple-error)
x))
17)
(deftest assert.8
(let ((x 0))
(handler-bind
((type-error #'(lambda (c)
(incf x)
(continue c))))
(assert (> x 5) () 'type-error)
x))
6)
(deftest assert.9
(let ((x 0))
(handler-bind
((type-error #'(lambda (c) (declare (ignore c))
(incf x)
(continue))))
(assert (> x 5) () 'type-error)
x))
6)
......@@ -110,6 +110,7 @@
(load "assert.lsp")
(load "error.lsp")
(load "cerror.lsp")
(load "check-type.lsp")
;;; Tests of conses
......
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