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

Diff of /gcl/ansi-tests/defgeneric-method-combination-and.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 and ((x rational)) (push 3 *x*) nil)                    (:method and ((x rational)) (push 3 *x*) nil)
17                    (:method and ((x number)) (push 2 *x*) t)                    (:method and ((x number)) (push 2 *x*) t)
18                    (:method and ((x t)) (push 1 *x*) 'a)))))                    (:method and ((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 and ((x rational)) (push 3 *x*) nil)                    (:method and ((x rational)) (push 3 *x*) nil)
36                    (:method and ((x number)) (push 2 *x*) t)                    (:method and ((x number)) (push 2 *x*) t)
37                    (:method and ((x t)) (push 1 *x*) 'a)))))                    (:method and ((x t)) (push 1 *x*) 'a)))))
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 52  Line 54 
54                    (:method and ((x rational)) (push 3 *x*) nil)                    (:method and ((x rational)) (push 3 *x*) nil)
55                    (:method and ((x number)) (push 2 *x*) 'a)                    (:method and ((x number)) (push 2 *x*) 'a)
56                    (:method and ((x t)) (push 1 *x*) t)))))                    (:method and ((x t)) (push 1 *x*) t)))))
57        (declare (type generic-function fn))
58      (flet ((%f (y)      (flet ((%f (y)
59                 (let ((*x* nil))                 (let ((*x* nil))
60                   (list (funcall fn y) *x*))))                   (list (funcall fn y) *x*))))
# Line 70  Line 73 
73                    (:method and ((x number)) nil)                    (:method and ((x number)) nil)
74                    (:method and ((x symbol)) t)                    (:method and ((x symbol)) t)
75                    (:method and ((x t)) 'a)))))                    (:method and ((x t)) 'a)))))
76        (declare (type generic-function fn))
77      (values      (values
78       (funcall fn 0)       (funcall fn 0)
79       (funcall fn 4/3)       (funcall fn 4/3)
# Line 88  Line 92 
92                    (:method and ((x number)) 'a)                    (:method and ((x number)) 'a)
93                    (:method and ((x symbol)) 'b)                    (:method and ((x symbol)) 'b)
94                    (:method and ((x t)) 'c)))))                    (:method and ((x t)) 'c)))))
95        (declare (type generic-function fn))
96      (values      (values
97       (funcall fn 0)       (funcall fn 0)
98       (funcall fn 4/3)       (funcall fn 4/3)
# Line 108  Line 113 
113                    (:method and ((x number)) nil)                    (:method and ((x number)) nil)
114                    (:method and ((x symbol)) 'c)                    (:method and ((x symbol)) 'c)
115                    (:method and ((x t)) 'd)))))                    (:method and ((x t)) 'd)))))
116        (declare (type generic-function fn))
117      (values      (values
118       (funcall fn 0)       (funcall fn 0)
119       (funcall fn 4/3)       (funcall fn 4/3)
# Line 125  Line 131 
131                    (:method and ((x dgmc-class-03)) 'b)                    (:method and ((x dgmc-class-03)) 'b)
132                    (:method and ((x dgmc-class-02)) nil)                    (:method and ((x dgmc-class-02)) nil)
133                    (:method and ((x dgmc-class-01)) 'a)))))                    (:method and ((x dgmc-class-01)) 'a)))))
134        (declare (type generic-function fn))
135      (values      (values
136       (funcall fn (make-instance 'dgmc-class-01))       (funcall fn (make-instance 'dgmc-class-01))
137       (funcall fn (make-instance 'dgmc-class-02))       (funcall fn (make-instance 'dgmc-class-02))
# Line 142  Line 149 
149                    (:method :around ((x complex)) (call-next-method))                    (:method :around ((x complex)) (call-next-method))
150                    (:method :around ((x number)) (values 1 2 3 4 5 6))                    (:method :around ((x number)) (values 1 2 3 4 5 6))
151                    (:method and ((x t)) 'b)))))                    (:method and ((x t)) 'b)))))
152        (declare (type generic-function fn))
153      (values      (values
154       (multiple-value-list (funcall fn 'a))       (multiple-value-list (funcall fn 'a))
155       (multiple-value-list (funcall fn 10))       (multiple-value-list (funcall fn 10))
# Line 153  Line 161 
161    (handler-case    (handler-case
162     (let ((fn (eval '(defgeneric dg-mc.and.9 (x)     (let ((fn (eval '(defgeneric dg-mc.and.9 (x)
163                        (:method-combination and)))))                        (:method-combination and)))))
164         (declare (type generic-function fn))
165       (funcall fn 'x))       (funcall fn 'x))
166     (error () :error))     (error () :error))
167    :error)    :error)
# Line 178  Line 187 
187                       (:method-combination and)                       (:method-combination and)
188                       (:method :around ((x t)) t)                       (:method :around ((x t)) t)
189                       (:method and ((x integer)) x)))))                       (:method and ((x integer)) x)))))
190        (declare (type generic-function fn))
191      (handler-case (funcall fn 'x)      (handler-case (funcall fn 'x)
192                    (error () :error)))                    (error () :error)))
193    :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