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 |
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 |
|
|