/[gcl]/gcl/ansi-tests/slot-exists-p.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/slot-exists-p.lsp

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

revision 1.4 by pfdietz, Sat May 10 19:05:59 2003 UTC revision 1.5 by pfdietz, Wed May 14 12:25:06 2003 UTC
# Line 117  Line 117 
117  ;;; (after all, they are objects, and they have slots)  ;;; (after all, they are objects, and they have slots)
118    
119  (define-condition slot-exists-p-condition-01 ()  (define-condition slot-exists-p-condition-01 ()
120    (a b c))    ((a) (b) (c)))
121    
122  (deftest slot-exists-p.15  (deftest slot-exists-p.15
123    (let ((obj (make-condition 'slot-exists-p-condition-01)))    (let ((obj (make-condition 'slot-exists-p-condition-01)))
# Line 125  Line 125 
125    (t t t nil))    (t t t nil))
126    
127  (define-condition slot-exists-p-condition-02 (slot-exists-p-condition-01)  (define-condition slot-exists-p-condition-02 (slot-exists-p-condition-01)
128    (a d e))    ((a) (d) (e)))
129    
130  (deftest slot-exists-p.16  (deftest slot-exists-p.16
131    (let ((obj (make-condition 'slot-exists-p-condition-02)))    (let ((obj (make-condition 'slot-exists-p-condition-02)))
132      (map-slot-exists-p* obj (list 'a 'b 'c 'd 'e (gensym))))      (map-slot-exists-p* obj (list 'a 'b 'c 'd 'e (gensym))))
133    (t t t t t nil))    (t t t t t nil))
134    
135    ;;; Order of evaluation tests
136    
137    (deftest slot-exists-p.order.1
138      (let ((i 0) x y)
139        (values
140         (slot-exists-p (progn (setf x (incf i)) 'a)
141                        (progn (setf y (incf i)) (gensym)))
142         i x y))
143      nil 2 1 2)
144    
145    (deftest slot-exists-p.order.2
146      (let ((obj (allocate-instance (find-class 'slot-exists-p-class-01)))
147            (i 0) x y)
148        (values
149         (notnot (slot-exists-p (progn (setf x (incf i)) obj)
150                                (progn (setf y (incf i)) 'a)))
151         i x y))
152      t 2 1 2)
153    
154    (deftest slot-exists-p.order.3
155      (let ((obj (allocate-instance (find-class 'slot-exists-p-class-01)))
156            (i 0) x y)
157        (values
158         (notnot (slot-exists-p (progn (setf x (incf i)) obj)
159                                (progn (setf y (incf i)) 'b)))
160         i x y))
161      t 2 1 2)
162    
163  ;;; Errors tests  ;;; Errors tests
164    

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

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