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

Diff of /gcl/ansi-tests/defgeneric-method-combination-or.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 16  Line 16 
16                    (:method or ((x rational)) (push 3 *x*) nil)                    (:method or ((x rational)) (push 3 *x*) nil)
17                    (:method or ((x number)) (push 2 *x*) nil)                    (:method or ((x number)) (push 2 *x*) nil)
18                    (:method or ((x t)) (push 1 *x*) 'a)))))                    (:method or ((x t)) (push 1 *x*) 'a)))))
19        (declare (type generic-function fn))
20      (flet ((%f (y)      (flet ((%f (y)
21                 (let ((*x* nil))                 (let ((*x* nil))
22                   (list (funcall fn y) *x*))))                   (list (funcall fn y) *x*))))
# Line 34  Line 35 
35                    (:method or ((x rational)) (push 3 *x*) 'a)                    (:method or ((x rational)) (push 3 *x*) 'a)
36                    (:method or ((x number)) (push 2 *x*) nil)                    (:method or ((x number)) (push 2 *x*) nil)
37                    (:method or ((x t)) (push 1 *x*) 'b)))))                    (:method or ((x t)) (push 1 *x*) 'b)))))
38        (declare (type generic-function fn))
39      (flet ((%f (y)      (flet ((%f (y)
40                 (let ((*x* nil))                 (let ((*x* nil))
41                   (list (funcall fn y) *x*))))                   (list (funcall fn y) *x*))))
# Line 49  Line 51 
51                    (:method or ((x rational)) (push 3 *x*) nil)                    (:method or ((x rational)) (push 3 *x*) nil)
52                    (:method or ((x number)) (push 2 *x*) nil)                    (:method or ((x number)) (push 2 *x*) nil)
53                    (:method or ((x t)) (push 1 *x*) nil)))))                    (:method or ((x t)) (push 1 *x*) nil)))))
54        (declare (type generic-function fn))
55      (flet ((%f (y)      (flet ((%f (y)
56                 (let ((*x* nil))                 (let ((*x* nil))
57                   (list (funcall fn y) *x*))))                   (list (funcall fn y) *x*))))
# Line 64  Line 67 
67                    (:method or ((x number)) 'b)                    (:method or ((x number)) 'b)
68                    (:method or ((x symbol)) nil)                    (:method or ((x symbol)) nil)
69                    (:method or ((x t)) 'a)))))                    (:method or ((x t)) 'a)))))
70        (declare (type generic-function fn))
71      (values      (values
72       (funcall fn 0)       (funcall fn 0)
73       (funcall fn 4/3)       (funcall fn 4/3)
# Line 82  Line 86 
86                    (:method or ((x number)) nil)                    (:method or ((x number)) nil)
87                    (:method or ((x symbol)) 'b)                    (:method or ((x symbol)) 'b)
88                    (:method or ((x t)) 'c)))))                    (:method or ((x t)) 'c)))))
89        (declare (type generic-function fn))
90      (values      (values
91       (funcall fn 0)       (funcall fn 0)
92       (funcall fn 4/3)       (funcall fn 4/3)
# Line 102  Line 107 
107                    (:method or ((x number)) 'b)                    (:method or ((x number)) 'b)
108                    (:method or ((x symbol)) 'c)                    (:method or ((x symbol)) 'c)
109                    (:method or ((x t)) 'd)))))                    (:method or ((x t)) 'd)))))
110        (declare (type generic-function fn))
111      (values      (values
112       (funcall fn 0)       (funcall fn 0)
113       (funcall fn 4/3)       (funcall fn 4/3)
# Line 119  Line 125 
125                    (:method or ((x dgmc-class-03)) nil)                    (:method or ((x dgmc-class-03)) nil)
126                    (:method or ((x dgmc-class-02)) 'b)                    (:method or ((x dgmc-class-02)) 'b)
127                    (:method or ((x dgmc-class-01)) 'c)))))                    (:method or ((x dgmc-class-01)) 'c)))))
128        (declare (type generic-function fn))
129      (values      (values
130       (funcall fn (make-instance 'dgmc-class-01))       (funcall fn (make-instance 'dgmc-class-01))
131       (funcall fn (make-instance 'dgmc-class-02))       (funcall fn (make-instance 'dgmc-class-02))
# Line 136  Line 143 
143                    (:method :around ((x complex)) (call-next-method))                    (:method :around ((x complex)) (call-next-method))
144                    (:method :around ((x number)) (values 1 2 3 4 5 6))                    (:method :around ((x number)) (values 1 2 3 4 5 6))
145                    (:method or ((x t)) 'b)))))                    (:method or ((x t)) 'b)))))
146        (declare (type generic-function fn))
147      (values      (values
148       (multiple-value-list (funcall fn 'a))       (multiple-value-list (funcall fn 'a))
149       (multiple-value-list (funcall fn 10))       (multiple-value-list (funcall fn 10))
# Line 147  Line 155 
155    (handler-case    (handler-case
156     (let ((fn (eval '(defgeneric dg-mc.or.9 (x)     (let ((fn (eval '(defgeneric dg-mc.or.9 (x)
157                        (:method-combination or)))))                        (:method-combination or)))))
158         (declare (type generic-function fn))
159       (funcall fn (list 'a)))       (funcall fn (list 'a)))
160     (error () :error))     (error () :error))
161    :error)    :error)
# Line 172  Line 181 
181                       (:method-combination or)                       (:method-combination or)
182                       (:method :around ((x t)) t)                       (:method :around ((x t)) t)
183                       (:method or ((x integer)) x)))))                       (:method or ((x integer)) x)))))
184        (declare (type generic-function fn))
185      (handler-case (funcall fn 'a)      (handler-case (funcall fn 'a)
186                    (error () :error)))                    (error () :error)))
187    :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