130 |
(funcall fn 'a)))) |
(funcall fn 'a)))) |
131 |
1 t 1 t 1) |
1 t 1 t 1) |
132 |
|
|
133 |
|
(deftest ensure-generic-function.11 |
134 |
|
(let ((f 'egf-fun-11)) |
135 |
|
(when (fboundp f) (fmakunbound f)) |
136 |
|
(let ((fn (eval `(defgeneric ,f (x) |
137 |
|
(:method ((x t)) 1))))) |
138 |
|
(values |
139 |
|
(funcall fn 'a) |
140 |
|
(eqlt fn (eval `(macrolet ((%m (&environment env) |
141 |
|
(ensure-generic-function ',f :lambda-list '(x) |
142 |
|
:environment env))) |
143 |
|
(%m)))) |
144 |
|
(funcall fn 'a)))) |
145 |
|
1 t 1) |
146 |
|
|
147 |
|
(deftest ensure-generic-function.12 |
148 |
|
(let ((f 'egf-fun-12)) |
149 |
|
(when (fboundp f) (fmakunbound f)) |
150 |
|
(let ((fn (eval `(defgeneric ,f (x) |
151 |
|
(:documentation "foo") |
152 |
|
(:method ((x t)) 1))))) |
153 |
|
(values |
154 |
|
(funcall fn 'a) |
155 |
|
(or (documentation f 'function) "foo") |
156 |
|
(eqlt fn (ensure-generic-function f :lambda-list '(x) :documentation "bar")) |
157 |
|
(or (documentation f 'function) "bar") |
158 |
|
(funcall fn 'a)))) |
159 |
|
1 "foo" t "bar" 1) |
160 |
|
|
161 |
|
(deftest ensure-generic-function.13 |
162 |
|
(let ((f 'egf-fun-13)) |
163 |
|
(when (fboundp f) (fmakunbound f)) |
164 |
|
(let ((fn (eval `(defgeneric ,f (x y) |
165 |
|
(declare (optimize safety (speed 0) (debug 0) (space 0))) |
166 |
|
(:method ((x t) (y t)) (list x y)))))) |
167 |
|
(values |
168 |
|
(funcall fn 'a 'b) |
169 |
|
(eqlt fn (ensure-generic-function f :lambda-list '(x y) |
170 |
|
:declare '(optimize (safety 0) (debug 2) speed (space 1)))) |
171 |
|
(funcall fn 'a 1)))) |
172 |
|
(a b) t (a 1)) |
173 |
|
|
174 |
|
(deftest ensure-generic-function.14 |
175 |
|
(let ((f '(setf egf-fun-14))) |
176 |
|
(when (fboundp f) (fmakunbound f)) |
177 |
|
(let ((fn (eval `(defgeneric ,f (val x) |
178 |
|
(:method ((val t) (x cons)) (setf (car x) val)))))) |
179 |
|
(values |
180 |
|
(let ((z (cons 'a 'b))) |
181 |
|
(list (setf (egf-fun-14 z) 'c) z)) |
182 |
|
(eqlt fn (ensure-generic-function f :lambda-list '(val x))) |
183 |
|
(let ((z (cons 'a 'b))) |
184 |
|
(list (setf (egf-fun-14 z) 'c) z))))) |
185 |
|
(c (c . b)) t (c (c . b))) |
186 |
|
|
187 |
;;; Many more tests are needed for other combinations of keyword parameters |
;;; Many more tests are needed for other combinations of keyword parameters |
188 |
|
|
189 |
(deftest ensure-generic-function.error.1 |
(deftest ensure-generic-function.error.1 |