source: trunk/source/tests/ansi-tests/allocate-instance.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 3.7 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Mon Apr 28 21:06:58 2003
4;;;; Contains: Tests of ALLOCATE-INSTANCE
5
6(in-package :cl-test)
7
8;;; According to the CLHS, the meaning of adding methods to
9;;; ALLOCATE-INSTANCE is unspecified, so this will not be tested
10;;; here.
11
12(defclass allocate-instance-class-01 ()
13  ((a :initform 'x) (b :initarg :b)
14   (c :type float) (d :allocation :class)
15   (e :initarg :e) (f :documentation "foo"))
16  (:default-initargs :b 'y))
17
18(deftest allocate-instance.1
19  (let* ((class (find-class 'allocate-instance-class-01))
20         (obj (allocate-instance class)))
21    (values
22     (eqt (class-of obj) class)
23     (typep* obj 'allocate-instance-class-01)
24     (typep* obj class)
25     (map-slot-boundp* obj '(a b c d e f))))
26  t t t
27  (nil nil nil nil nil nil))
28
29(deftest allocate-instance.2
30  (let* ((class (find-class 'allocate-instance-class-01))
31         (obj (allocate-instance class
32                                 :foo t :a 10 :b 12 :c 1.0 :d 'a :e 17
33                                 :f nil :bar t)))
34    (values
35     (eqt (class-of obj) class)
36     (typep* obj 'allocate-instance-class-01)
37     (typep* obj class)
38     (map-slot-boundp* obj '(a b c d e f))))
39  t t t
40  (nil nil nil nil nil nil))
41
42(deftest allocate-instance.3
43  (let* ((class (find-class 'allocate-instance-class-01))
44         (obj (allocate-instance class :allow-other-keys nil :xyzzy t)))
45    (values
46     (eqt (class-of obj) class)
47     (typep* obj 'allocate-instance-class-01)
48     (typep* obj class)
49     (map-slot-boundp* obj '(a b c d e f))))
50  t t t
51  (nil nil nil nil nil nil))
52
53(defclass allocate-instance-class-02 ()
54  (a (b :allocation :class)))
55
56(deftest allocate-instance.4
57  (let ((class (find-class 'allocate-instance-class-02)))
58    (setf (slot-value (allocate-instance class) 'b) 'x)
59    (let ((obj (allocate-instance class)))
60      (values
61       (eqt (class-of obj) class)
62       (typep* obj 'allocate-instance-class-02)
63       (typep* obj class)
64       (slot-boundp* obj 'a)
65       (slot-value obj 'b))))
66  t t t nil x)
67
68(defstruct allocate-instance-struct-01
69  a
70  (b 0 :type integer)
71  (c #\a :type character)
72  (d 'a :type symbol))
73
74(deftest allocate-instance.5
75  (let* ((class (find-class 'allocate-instance-struct-01))
76         (obj   (allocate-instance class)))
77    (setf (allocate-instance-struct-01-a obj) 'x
78          (allocate-instance-struct-01-b obj) 1234567890
79          (allocate-instance-struct-01-c obj) #\Z
80          (allocate-instance-struct-01-d obj) 'foo)
81    (values
82     (eqt (class-of obj) class)
83     (typep* obj 'allocate-instance-struct-01)
84     (typep* obj class)
85     (allocate-instance-struct-01-a obj)
86     (allocate-instance-struct-01-b obj)
87     (allocate-instance-struct-01-c obj)
88     (allocate-instance-struct-01-d obj)))
89  t t t
90  x 1234567890 #\Z foo)
91
92;;; Order of evaluation tests
93
94(deftest allocate-instance.order.1
95  (let* ((class (find-class 'allocate-instance-class-01))
96         (i 0) x y z w
97         (obj (allocate-instance (progn (setf x (incf i)) class)
98                                 :e (setf y (incf i))
99                                 :b (setf z (incf i))
100                                 :e (setf w (incf i)))))
101    (values
102     (eqt (class-of obj) class)
103     (typep* obj 'allocate-instance-class-01)
104     (typep* obj class)
105     i x y z w))
106  t t t 4 1 2 3 4)
107
108;;; Error tests
109
110(deftest allocate-instance.error.1
111  (signals-error (allocate-instance) program-error)
112  t)
113
114;;; Duane Rettig made a convincing argument that the next two
115;;; tests are bad, since the caller of allocate-instance
116;;; is supposed to have checked that the initargs are valid
117
118#|
119(deftest allocate-instance.error.2
120  (signals-error (allocate-instance (find-class 'allocate-instance-class-01)
121                                     :b)
122                 program-error)
123  t)
124
125(deftest allocate-instance.error.3
126  (signals-error (allocate-instance (find-class 'allocate-instance-class-01)
127                                     '(a b c) nil)
128                 program-error)
129  t)
130|#
Note: See TracBrowser for help on using the repository browser.