Commit 17e2d7b9 authored by pfdietz's avatar pfdietz

More tests, mostly order of argument evaluation.

parent 35b12e67
......@@ -89,6 +89,24 @@
t t t
x 1234567890 #\Z foo)
;;; Order of evaluation tests
(deftest allocate-instance.order.1
(let* ((class (find-class 'allocate-instance-class-01))
(i 0) x y z w
(obj (allocate-instance (progn (setf x (incf i)) class)
:e (setf y (incf i))
:b (setf z (incf i))
:e (setf w (incf i)))))
(values
(eqt (class-of obj) class)
(typep* obj 'allocate-instance-class-01)
(typep* obj class)
i x y z w))
t t t 4 1 2 3 4)
;;; Error tests
(deftest allocate-instance.error.1
(classify-error (allocate-instance))
program-error)
......
......@@ -32,6 +32,10 @@
(error () :good))
:good)
(deftest make-instance.error.5
(classify-error (let () (make-instance) nil))
program-error)
;; Definitions of methods
(defmethod make-instance ((x (eql 'foo)) &rest initargs &key &allow-other-keys)
......@@ -85,3 +89,45 @@
(slot-value obj 'b)
(slot-value obj 'c)))
t nil g nil)
(deftest make-instance.6
(eq (make-instance 'make-instance-class-02)
(make-instance 'make-instance-class-02))
nil)
;;; Order of argument evaluation
(deftest make-instance.order.1
(let* ((i 0) x y
(obj (make-instance 'make-instance-class-01
:a (setf x (incf i))
:b (setf y (incf i)))))
(values
(map-slot-value obj '(a b))
i x y))
(1 2) 2 1 2)
(deftest make-instance.order.2
(let* ((i 0) x y z w
(obj (make-instance 'make-instance-class-01
:a (setf x (incf i))
:b (setf y (incf i))
:b (setf z (incf i))
:a (setf w (incf i)))))
(values
(map-slot-value obj '(a b))
i x y z w))
(1 2) 4 1 2 3 4)
(deftest make-instance.order.3
(let* ((i 0) u x y z w
(obj (make-instance (prog1 'make-instance-class-01
(setf u (incf i)))
:a (setf x (incf i))
:b (setf y (incf i))
:b (setf z (incf i))
:a (setf w (incf i)))))
(values
(map-slot-value obj '(a b))
i u x y z w))
(2 3) 5 1 2 3 4 5)
......@@ -105,6 +105,22 @@
(map-slot-value obj2 '(a b))))
t (3 20))
;;; Order of evaluation tests
(deftest reinitialize-instance.order.1
(let* ((obj (make-instance 'reinit-class-01))
(i 0) x y z w
(obj2 (reinitialize-instance
(progn (setf x (incf i)) obj)
:b (setf y (incf i))
:a (setf z (incf i))
:b (setf w (incf i)))))
(values
(eqt obj obj2)
(map-slot-value obj2 '(a b))
i x y z w))
t (3 2) 4 1 2 3 4)
;;; Error cases
(deftest reinitialize-instance.error.1
......@@ -116,10 +132,3 @@
(deftest reinitialize-instance.error.2
(classify-error (reinitialize-instance))
program-error)
......@@ -654,6 +654,24 @@
(nil t)
y)
;;; Order of evaluation tests
(deftest shared-initialize.order.1
(let ((obj (allocate-instance (find-class 'shared-init-class-01)))
(i 0) x r y z w q)
(values
(eqt obj
(shared-initialize (progn (setf x (incf i)) obj)
(progn (setf r (incf i)) nil)
:b (setf y (incf i))
:a (setf z (incf i))
:b (setf w (incf i))
:c (setf q (incf i))))
(map-slot-value obj '(a b c))
i x r y z w q))
t (4 3 6)
6 1 2 3 4 5 6)
;;; Error tests
(deftest shared-initialize.error.1
......@@ -677,8 +695,3 @@
(find-class 'shared-init-class-01))))
(shared-initialize obj nil '(a b c) nil)))
program-error)
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