/[gcl]/gcl/ansi-tests/make-instance.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/make-instance.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by pfdietz, Tue May 13 02:53:55 2003 UTC revision 1.2 by pfdietz, Thu May 15 12:12:32 2003 UTC
# Line 32  Line 32 
32                  (error () :good))                  (error () :good))
33    :good)    :good)
34    
35    (deftest make-instance.error.5
36      (classify-error (let () (make-instance) nil))
37      program-error)
38    
39  ;; Definitions of methods  ;; Definitions of methods
40    
41  (defmethod make-instance ((x (eql 'foo)) &rest initargs &key &allow-other-keys)  (defmethod make-instance ((x (eql 'foo)) &rest initargs &key &allow-other-keys)
# Line 85  Line 89 
89       (slot-value obj 'b)       (slot-value obj 'b)
90       (slot-value obj 'c)))       (slot-value obj 'c)))
91    t nil g nil)    t nil g nil)
92    
93    (deftest make-instance.6
94      (eq (make-instance 'make-instance-class-02)
95          (make-instance 'make-instance-class-02))
96      nil)
97    
98    ;;; Order of argument evaluation
99    
100    (deftest make-instance.order.1
101      (let* ((i 0) x y
102             (obj (make-instance 'make-instance-class-01
103                                 :a (setf x (incf i))
104                                 :b (setf y (incf i)))))
105        (values
106         (map-slot-value obj '(a b))
107         i x y))
108      (1 2) 2 1 2)
109    
110    (deftest make-instance.order.2
111      (let* ((i 0) x y z w
112             (obj (make-instance 'make-instance-class-01
113                                 :a (setf x (incf i))
114                                 :b (setf y (incf i))
115                                 :b (setf z (incf i))
116                                 :a (setf w (incf i)))))
117        (values
118         (map-slot-value obj '(a b))
119         i x y z w))
120      (1 2) 4 1 2 3 4)
121    
122    (deftest make-instance.order.3
123      (let* ((i 0) u x y z w
124             (obj (make-instance (prog1 'make-instance-class-01
125                                        (setf u (incf i)))
126                                 :a (setf x (incf i))
127                                 :b (setf y (incf i))
128                                 :b (setf z (incf i))
129                                 :a (setf w (incf i)))))
130        (values
131         (map-slot-value obj '(a b))
132         i u x y z w))
133      (2 3) 5 1 2 3 4 5)

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26