/[gcl]/gcl/ansi-tests/ensure-generic-function.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/ensure-generic-function.lsp

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

revision 1.5 by pfdietz, Tue Apr 26 02:29:48 2005 UTC revision 1.6 by pfdietz, Tue Apr 26 03:48:44 2005 UTC
# Line 130  Line 130 
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

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6

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