/[gcl]/gcl/ansi-tests/defgeneric-method-combination-nconc.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/defgeneric-method-combination-nconc.lsp

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

revision 1.2 by pfdietz, Wed Jun 4 01:04:49 2003 UTC revision 1.3 by pfdietz, Tue Jul 1 12:16:10 2003 UTC
# Line 20  Line 20 
20                             (copy-list (car (push '(b) *x*))))                             (copy-list (car (push '(b) *x*))))
21                    (:method nconc ((x t))                    (:method nconc ((x t))
22                             (copy-list (car (push '(a) *x*))))))))                             (copy-list (car (push '(a) *x*))))))))
23        (declare (type generic-function fn))
24      (flet ((%f (y)      (flet ((%f (y)
25                 (let ((*x* nil))                 (let ((*x* nil))
26                   (list (funcall fn y) *x*))))                   (list (funcall fn y) *x*))))
# Line 42  Line 43 
43                             (copy-list (car (push '(b) *x*))))                             (copy-list (car (push '(b) *x*))))
44                    (:method nconc ((x t))                    (:method nconc ((x t))
45                             (copy-list (car (push '(a) *x*))))))))                             (copy-list (car (push '(a) *x*))))))))
46        (declare (type generic-function fn))
47      (flet ((%f (y)      (flet ((%f (y)
48                 (let ((*x* nil))                 (let ((*x* nil))
49                   (list (funcall fn y) *x*))))                   (list (funcall fn y) *x*))))
# Line 64  Line 66 
66                             (copy-list (car (push '(b) *x*))))                             (copy-list (car (push '(b) *x*))))
67                    (:method nconc ((x t))                    (:method nconc ((x t))
68                             (copy-list (car (push '(a) *x*))))))))                             (copy-list (car (push '(a) *x*))))))))
69        (declare (type generic-function fn))
70      (flet ((%f (y)      (flet ((%f (y)
71                 (let ((*x* nil))                 (let ((*x* nil))
72                   (list (funcall fn y) *x*))))                   (list (funcall fn y) *x*))))
# Line 82  Line 85 
85                    (:method nconc ((x number)) (list 'c 'd))                    (:method nconc ((x number)) (list 'c 'd))
86                    (:method nconc ((x symbol)) (list 'e 'f))                    (:method nconc ((x symbol)) (list 'e 'f))
87                    (:method nconc ((x t)) (list 'g 'h))))))                    (:method nconc ((x t)) (list 'g 'h))))))
88        (declare (type generic-function fn))
89      (values      (values
90       (funcall fn 0)       (funcall fn 0)
91       (funcall fn 4/3)       (funcall fn 4/3)
# Line 100  Line 104 
104                    (:method nconc ((x number)) (list 'b))                    (:method nconc ((x number)) (list 'b))
105                    (:method nconc ((x symbol)) (list 'c))                    (:method nconc ((x symbol)) (list 'c))
106                    (:method nconc ((x t)) (cons 'd 'e))))))                    (:method nconc ((x t)) (cons 'd 'e))))))
107        (declare (type generic-function fn))
108      (values      (values
109       (funcall fn 0)       (funcall fn 0)
110       (funcall fn 4/3)       (funcall fn 4/3)
# Line 120  Line 125 
125                    (:method nconc ((x number)) (list 'b))                    (:method nconc ((x number)) (list 'b))
126                    (:method nconc ((x symbol)) (list 'c))                    (:method nconc ((x symbol)) (list 'c))
127                    (:method nconc ((x t)) (list 'd))))))                    (:method nconc ((x t)) (list 'd))))))
128        (declare (type generic-function fn))
129      (values      (values
130       (funcall fn 0)       (funcall fn 0)
131       (funcall fn 4/3)       (funcall fn 4/3)
# Line 137  Line 143 
143                    (:method nconc ((x dgmc-class-03)) (list 'b))                    (:method nconc ((x dgmc-class-03)) (list 'b))
144                    (:method nconc ((x dgmc-class-02)) (list 'c))                    (:method nconc ((x dgmc-class-02)) (list 'c))
145                    (:method nconc ((x dgmc-class-01)) (list 'd))))))                    (:method nconc ((x dgmc-class-01)) (list 'd))))))
146        (declare (type generic-function fn))
147      (values      (values
148       (funcall fn (make-instance 'dgmc-class-01))       (funcall fn (make-instance 'dgmc-class-01))
149       (funcall fn (make-instance 'dgmc-class-02))       (funcall fn (make-instance 'dgmc-class-02))
# Line 157  Line 164 
164                    (:method :around ((x complex)) (call-next-method))                    (:method :around ((x complex)) (call-next-method))
165                    (:method :around ((x number)) (values 1 2 3 4 5 6))                    (:method :around ((x number)) (values 1 2 3 4 5 6))
166                    (:method nconc ((x t)) (list 'b))))))                    (:method nconc ((x t)) (list 'b))))))
167        (declare (type generic-function fn))
168      (values      (values
169       (multiple-value-list (funcall fn 'a))       (multiple-value-list (funcall fn 'a))
170       (multiple-value-list (funcall fn 10))       (multiple-value-list (funcall fn 10))
# Line 168  Line 176 
176    (handler-case    (handler-case
177     (let ((fn (eval '(defgeneric dg-mc.nconc.9 (x)     (let ((fn (eval '(defgeneric dg-mc.nconc.9 (x)
178                        (:method-combination nconc)))))                        (:method-combination nconc)))))
179         (declare (type generic-function fn))
180       (funcall fn (list 'a)))       (funcall fn (list 'a)))
181     (error () :error))     (error () :error))
182    :error)    :error)
# Line 193  Line 202 
202                       (:method-combination nconc)                       (:method-combination nconc)
203                       (:method :around ((x t)) (list 'a))                       (:method :around ((x t)) (list 'a))
204                       (:method nconc ((x integer)) x)))))                       (:method nconc ((x integer)) x)))))
205        (declare (type generic-function fn))
206      (handler-case (funcall fn (list 'b))      (handler-case (funcall fn (list 'b))
207                    (error () :error)))                    (error () :error)))
208    :error)    :error)

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

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