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

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

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

revision 1.3 by pfdietz, Wed Jun 4 01:04:49 2003 UTC revision 1.4 by pfdietz, Tue Jul 1 12:16:10 2003 UTC
# Line 16  Line 16 
16                    (:method + ((x rational)) (car (push 4 *x*)))                    (:method + ((x rational)) (car (push 4 *x*)))
17                    (:method + ((x number)) (car (push 2 *x*)))                    (:method + ((x number)) (car (push 2 *x*)))
18                    (:method + ((x t)) (car (push 1 *x*)))))))                    (:method + ((x t)) (car (push 1 *x*)))))))
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 31  Line 32 
32                    (:method + ((x rational)) (car (push 4 *x*)))                    (:method + ((x rational)) (car (push 4 *x*)))
33                    (:method + ((x number)) (car (push 2 *x*)))                    (:method + ((x number)) (car (push 2 *x*)))
34                    (:method + ((x t)) (car (push 1 *x*)))))))                    (:method + ((x t)) (car (push 1 *x*)))))))
35        (declare (type generic-function fn))
36      (flet ((%f (y)      (flet ((%f (y)
37                 (let ((*x* nil))                 (let ((*x* nil))
38                   (list (funcall fn y) *x*))))                   (list (funcall fn y) *x*))))
# Line 46  Line 48 
48                    (:method + ((x rational)) (car (push 4 *x*)))                    (:method + ((x rational)) (car (push 4 *x*)))
49                    (:method + ((x number)) (car (push 2 *x*)))                    (:method + ((x number)) (car (push 2 *x*)))
50                    (:method + ((x t)) (car (push 1 *x*)))))))                    (:method + ((x t)) (car (push 1 *x*)))))))
51        (declare (type generic-function fn))
52      (flet ((%f (y)      (flet ((%f (y)
53                 (let ((*x* nil))                 (let ((*x* nil))
54                   (list (funcall fn y) *x*))))                   (list (funcall fn y) *x*))))
# Line 61  Line 64 
64                    (:method + ((x number)) 1)                    (:method + ((x number)) 1)
65                    (:method + ((x symbol)) 2)                    (:method + ((x symbol)) 2)
66                    (:method + ((x t)) 4)))))                    (:method + ((x t)) 4)))))
67        (declare (type generic-function fn))
68      (values      (values
69       (funcall fn 0)       (funcall fn 0)
70       (funcall fn 4/3)       (funcall fn 4/3)
# Line 79  Line 83 
83                    (:method + ((x number)) 2)                    (:method + ((x number)) 2)
84                    (:method + ((x symbol)) 4)                    (:method + ((x symbol)) 4)
85                    (:method + ((x t)) 8)))))                    (:method + ((x t)) 8)))))
86        (declare (type generic-function fn))
87      (values      (values
88       (funcall fn 0)       (funcall fn 0)
89       (funcall fn 4/3)       (funcall fn 4/3)
# Line 99  Line 104 
104                    (:method + ((x number)) 2)                    (:method + ((x number)) 2)
105                    (:method + ((x symbol)) 4)                    (:method + ((x symbol)) 4)
106                    (:method + ((x t)) 8)))))                    (:method + ((x t)) 8)))))
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 116  Line 122 
122                    (:method + ((x dgmc-class-03)) 2)                    (:method + ((x dgmc-class-03)) 2)
123                    (:method + ((x dgmc-class-02)) 4)                    (:method + ((x dgmc-class-02)) 4)
124                    (:method + ((x dgmc-class-01)) 8)))))                    (:method + ((x dgmc-class-01)) 8)))))
125        (declare (type generic-function fn))
126      (values      (values
127       (funcall fn (make-instance 'dgmc-class-01))       (funcall fn (make-instance 'dgmc-class-01))
128       (funcall fn (make-instance 'dgmc-class-02))       (funcall fn (make-instance 'dgmc-class-02))
# Line 133  Line 140 
140                    (:method :around ((x complex)) (call-next-method))                    (:method :around ((x complex)) (call-next-method))
141                    (:method :around ((x number)) (values 1 2 3 4 5 6))                    (:method :around ((x number)) (values 1 2 3 4 5 6))
142                    (:method + ((x t)) 1)))))                    (:method + ((x t)) 1)))))
143        (declare (type generic-function fn))
144      (values      (values
145       (multiple-value-list (funcall fn 'a))       (multiple-value-list (funcall fn 'a))
146       (multiple-value-list (funcall fn 10))       (multiple-value-list (funcall fn 10))
# Line 144  Line 152 
152    (handler-case    (handler-case
153     (let ((fn (eval '(defgeneric dg-mc.+.9 (x)     (let ((fn (eval '(defgeneric dg-mc.+.9 (x)
154                        (:method-combination +)))))                        (:method-combination +)))))
155         (declare (type generic-function fn))
156       (funcall fn (list 'a)))       (funcall fn (list 'a)))
157     (error () :error))     (error () :error))
158    :error)    :error)
# Line 169  Line 178 
178                       (:method-combination +)                       (:method-combination +)
179                       (:method :around ((x t)) 1)                       (:method :around ((x t)) 1)
180                       (:method + ((x integer)) x)))))                       (:method + ((x integer)) x)))))
181        (declare (type generic-function fn))
182      (handler-case (funcall fn 'a)      (handler-case (funcall fn 'a)
183                    (error () :error)))                    (error () :error)))
184    :error)    :error)

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

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