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

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

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

revision 1.1 by pfdietz, Sun May 25 12:40:44 2003 UTC revision 1.2 by pfdietz, Wed May 28 13:32:38 2003 UTC
# Line 7  Line 7 
7    
8  (declaim (special *x*))  (declaim (special *x*))
9    
10    (defclass dgmc-class-01 () ())
11    (defclass dgmc-class-02 (dgmc-class-01) ())
12    (defclass dgmc-class-03 (dgmc-class-01) ())
13    (defclass dgmc-class-04 (dgmc-class-02 dgmc-class-03) ())
14    (defclass dgmc-class-05 (dgmc-class-04) ())
15    (defclass dgmc-class-06 (dgmc-class-04) ())
16    (defclass dgmc-class-07 (dgmc-class-05 dgmc-class-06) ())
17    
18  (deftest defgeneric-method-combination.1  (deftest defgeneric-method-combination.1
19    (let ((*x* nil)    (let ((*x* nil)
20          (fn          (fn
# Line 69  Line 77 
77       (funcall fn '(a b c))))       (funcall fn '(a b c))))
78    foo foo 5 6 4)    foo foo 5 6 4)
79    
80    (deftest defgeneric-method-combination.5
81      (let ((fn
82             (eval '(defgeneric dg-mc.5 (x)
83                      (:method-combination +)
84                      (:method + ((x integer)) 1)
85                      (:method :around ((x rational))
86                               (list 'foo (call-next-method)))
87                      (:method + ((x number)) 2)
88                      (:method + ((x symbol)) 4)
89                      (:method + ((x t)) 8)))))
90        (values
91         (funcall fn 0)
92         (funcall fn 4/3)
93         (funcall fn 1.54)
94         (funcall fn 'x)
95         (funcall fn '(a b c))))
96      (foo 11) (foo 10) 10 12 8)
97    
98    (deftest defgeneric-method-combination.6
99      (let ((fn
100             (eval '(defgeneric dg-mc.6 (x)
101                      (:method-combination +)
102                      (:method + ((x integer)) 1)
103                      (:method :around ((x rational))
104                               (list 'foo (call-next-method)))
105                      (:method :around ((x real))
106                               (list 'bar (call-next-method)))
107                      (:method + ((x number)) 2)
108                      (:method + ((x symbol)) 4)
109                      (:method + ((x t)) 8)))))
110        (values
111         (funcall fn 0)
112         (funcall fn 4/3)
113         (funcall fn 1.54)
114         (funcall fn #c(1.0 2.0))
115         (funcall fn 'x)
116         (funcall fn '(a b c))))
117      (foo (bar 11)) (foo (bar 10)) (bar 10) 10 12 8)
118    
119    (deftest defgeneric-method-combination.7
120      (let ((fn
121             (eval '(defgeneric dg-mc.7 (x)
122                      (:method-combination +)
123                      (:method + ((x dgmc-class-04)) 1)
124                      (:method + ((x dgmc-class-03)) 2)
125                      (:method + ((x dgmc-class-02)) 4)
126                      (:method + ((x dgmc-class-01)) 8)))))
127        (values
128         (funcall fn (make-instance 'dgmc-class-01))
129         (funcall fn (make-instance 'dgmc-class-02))
130         (funcall fn (make-instance 'dgmc-class-03))
131         (funcall fn (make-instance 'dgmc-class-04))))
132      8 12 10 15)
133    
134    (deftest defgeneric-method-combination.8
135      (let ((fn
136             (eval '(defgeneric dg-mc.8 (x)
137                      (:method-combination +)
138                      (:method + ((x (eql 1000))) 1)
139                      (:method :around ((x symbol)) (values))
140                      (:method :around ((x integer)) (values 'a 'b 'c))
141                      (:method :around ((x complex)) (call-next-method))
142                      (:method :around ((x number)) (values 1 2 3 4 5 6))
143                      (:method + ((x t)) 1)))))
144        (values
145         (multiple-value-list (funcall fn 'a))
146         (multiple-value-list (funcall fn 10))
147         (multiple-value-list (funcall fn #c(9 8)))
148         (multiple-value-list (funcall fn '(a b c)))))
149      () (a b c) (1 2 3 4 5 6) (1))
150    
151    
152    
153    
154            
155                          

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

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