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

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

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

revision 1.17 by pfdietz, Thu May 29 12:28:08 2003 UTC revision 1.18 by pfdietz, Thu Jul 3 12:14:04 2003 UTC
# Line 212  Line 212 
212  (deftest defgeneric.1  (deftest defgeneric.1
213    (let ((fn (eval '(defgeneric defgeneric.fun.1 (x y z)    (let ((fn (eval '(defgeneric defgeneric.fun.1 (x y z)
214                       (:method ((x t) (y t) (z t)) (list x y z))))))                       (:method ((x t) (y t) (z t)) (list x y z))))))
215        (declare (type function fn))
216      (values      (values
217       (typep* fn 'generic-function)       (typep* fn 'generic-function)
218       (typep* fn 'standard-generic-function)       (typep* fn 'standard-generic-function)
# Line 226  Line 227 
227    (let ((fn (eval '(defgeneric defgeneric.fun.2 (x y z)    (let ((fn (eval '(defgeneric defgeneric.fun.2 (x y z)
228                       (:documentation "boo!")                       (:documentation "boo!")
229                       (:method ((x t) (y t) (z t)) (vector x y z))))))                       (:method ((x t) (y t) (z t)) (vector x y z))))))
230        (declare (type function fn))
231      (values      (values
232       (typep* fn 'generic-function)       (typep* fn 'generic-function)
233       (typep* fn 'standard-generic-function)       (typep* fn 'standard-generic-function)
# Line 252  Line 254 
254    (let ((fn (eval '(defgeneric defgeneric.fun.3 (x y)    (let ((fn (eval '(defgeneric defgeneric.fun.3 (x y)
255                       (:method ((x t) (y symbol)) (list x y))                       (:method ((x t) (y symbol)) (list x y))
256                       (:method ((x symbol) (y t)) (list y x))))))                       (:method ((x symbol) (y t)) (list y x))))))
257        (declare (type function fn))
258      (values      (values
259       (typep* fn 'generic-function)       (typep* fn 'generic-function)
260       (typep* fn 'standard-generic-function)       (typep* fn 'standard-generic-function)
# Line 268  Line 271 
271                       (:argument-precedence-order y x)                       (:argument-precedence-order y x)
272                       (:method ((x t) (y symbol)) (list x y))                       (:method ((x t) (y symbol)) (list x y))
273                       (:method ((x symbol) (y t)) (list y x))))))                       (:method ((x symbol) (y t)) (list y x))))))
274        (declare (type function fn))
275      (values      (values
276       (typep* fn 'generic-function)       (typep* fn 'generic-function)
277       (typep* fn 'standard-generic-function)       (typep* fn 'standard-generic-function)
# Line 282  Line 286 
286  (deftest defgeneric.5  (deftest defgeneric.5
287    (let ((fn (eval '(defgeneric defgeneric.fun.5 ()    (let ((fn (eval '(defgeneric defgeneric.fun.5 ()
288                       (:method () (values))))))                       (:method () (values))))))
289        (declare (type function fn))
290      (values      (values
291       (typep* fn 'generic-function)       (typep* fn 'generic-function)
292       (typep* fn 'standard-generic-function)       (typep* fn 'standard-generic-function)
# Line 293  Line 298 
298  (deftest defgeneric.6  (deftest defgeneric.6
299    (let ((fn (eval '(defgeneric defgeneric.fun.6 ()    (let ((fn (eval '(defgeneric defgeneric.fun.6 ()
300                       (:method () (values 'a 'b 'c))))))                       (:method () (values 'a 'b 'c))))))
301        (declare (type function fn))
302      (values      (values
303       (typep* fn 'generic-function)       (typep* fn 'generic-function)
304       (typep* fn 'standard-generic-function)       (typep* fn 'standard-generic-function)
# Line 304  Line 310 
310  (deftest defgeneric.7  (deftest defgeneric.7
311    (let ((fn (eval '(defgeneric defgeneric.fun.7 ()    (let ((fn (eval '(defgeneric defgeneric.fun.7 ()
312                       (:method () (return-from defgeneric.fun.7 'a) 'b)))))                       (:method () (return-from defgeneric.fun.7 'a) 'b)))))
313        (declare (type function fn))
314      (values      (values
315       (typep* fn 'generic-function)       (typep* fn 'generic-function)
316       (typep* fn 'standard-generic-function)       (typep* fn 'standard-generic-function)
# Line 318  Line 325 
325                                (list x y z))                                (list x y z))
326                       (:method ((p symbol) &optional q r)                       (:method ((p symbol) &optional q r)
327                                (list r q p))))))                                (list r q p))))))
328        (declare (type function fn))
329      (values      (values
330       (typep* fn 'generic-function)       (typep* fn 'generic-function)
331       (typep* fn 'standard-generic-function)       (typep* fn 'standard-generic-function)
# Line 343  Line 351 
351                                (list x y z))                                (list x y z))
352                       (:method ((p symbol) &optional (q 's) (r 't))                       (:method ((p symbol) &optional (q 's) (r 't))
353                                (list r q p))))))                                (list r q p))))))
354        (declare (type function fn))
355      (values      (values
356       (funcall fn 1)       (funcall fn 1)
357       (funcall fn 1 2)       (funcall fn 1 2)
# Line 360  Line 369 
369   (deftest defgeneric.10   (deftest defgeneric.10
370     (let ((fn (eval '(defgeneric defgeneric.fun.10 (x &rest y)     (let ((fn (eval '(defgeneric defgeneric.fun.10 (x &rest y)
371                        (:method ((x number) &key foo) (list x foo))))))                        (:method ((x number) &key foo) (list x foo))))))
372         (declare (type function fn))
373       (values       (values
374        (funcall fn 1)        (funcall fn 1)
375        (funcall fn 1 :foo 'a)        (funcall fn 1 :foo 'a)
# Line 375  Line 385 
385   (deftest defgeneric.11   (deftest defgeneric.11
386     (let ((fn (eval '(defgeneric defgeneric.fun.11 (x &key)     (let ((fn (eval '(defgeneric defgeneric.fun.11 (x &key)
387                        (:method ((x number) &key foo) (list x foo))))))                        (:method ((x number) &key foo) (list x foo))))))
388         (declare (type function fn))
389       (values       (values
390        (funcall fn 1)        (funcall fn 1)
391        (funcall fn 1 :foo 'a)        (funcall fn 1 :foo 'a)
# Line 390  Line 401 
401   (deftest defgeneric.12   (deftest defgeneric.12
402     (let ((fn (eval '(defgeneric defgeneric.fun.12 (x &key foo bar baz)     (let ((fn (eval '(defgeneric defgeneric.fun.12 (x &key foo bar baz)
403                        (:method ((x number) &rest y) (list x y))))))                        (:method ((x number) &rest y) (list x y))))))
404         (declare (type function fn))
405       (values       (values
406        (funcall fn 1)        (funcall fn 1)
407        (funcall fn 1 :foo 'a)        (funcall fn 1 :foo 'a)
# Line 406  Line 418 
418     (let ((fn (eval '(defgeneric defgeneric.fun.13 (x &key)     (let ((fn (eval '(defgeneric defgeneric.fun.13 (x &key)
419                        (:method ((x number) &key foo) (list x foo))                        (:method ((x number) &key foo) (list x foo))
420                        (:method ((x symbol) &key bar) (list x bar))))))                        (:method ((x symbol) &key bar) (list x bar))))))
421         (declare (type function fn))
422       (values       (values
423        (funcall fn 1)        (funcall fn 1)
424        (funcall fn 'a)        (funcall fn 'a)
# Line 430  Line 443 
443     (let ((fn (eval '(defgeneric defgeneric.fun.14 (x &key &allow-other-keys)     (let ((fn (eval '(defgeneric defgeneric.fun.14 (x &key &allow-other-keys)
444                        (:method ((x number) &key foo) (list x foo))                        (:method ((x number) &key foo) (list x foo))
445                        (:method ((x symbol) &key bar) (list x bar))))))                        (:method ((x symbol) &key bar) (list x bar))))))
446         (declare (type function fn))
447       (values       (values
448        (funcall fn 1)        (funcall fn 1)
449        (funcall fn 'a)        (funcall fn 'a)
# Line 462  Line 476 
476                        (:method ((x number) &key foo &allow-other-keys)                        (:method ((x number) &key foo &allow-other-keys)
477                                 (list x foo))                                 (list x foo))
478                        (:method ((x symbol) &key bar) (list x bar))))))                        (:method ((x symbol) &key bar) (list x bar))))))
479         (declare (type function fn))
480       (values       (values
481        (funcall fn 1)        (funcall fn 1)
482        (funcall fn 'a)        (funcall fn 'a)
# Line 496  Line 511 
511                                 (list x foo))                                 (list x foo))
512                        (:method ((x symbol) &key foo)                        (:method ((x symbol) &key foo)
513                                 (list x foo))))))                                 (list x foo))))))
514         (declare (type function fn))
515       (values       (values
516        (funcall fn 1)        (funcall fn 1)
517        (funcall fn 1 :foo nil)        (funcall fn 1 :foo nil)
# Line 516  Line 532 
532                                 (list x foo (notnot foo-p)))                                 (list x foo (notnot foo-p)))
533                        (:method ((x symbol) &key foo)                        (:method ((x symbol) &key foo)
534                                 (list x foo))))))                                 (list x foo))))))
535         (declare (type function fn))
536       (values       (values
537        (funcall fn 1)        (funcall fn 1)
538        (funcall fn 1 :foo nil)        (funcall fn 1 :foo nil)
# Line 536  Line 553 
553                                 (list x y))                                 (list x y))
554                        (:method ((x symbol) &optional (z nil z-p))                        (:method ((x symbol) &optional (z nil z-p))
555                                 (list x z (notnot z-p)))))))                                 (list x z (notnot z-p)))))))
556         (declare (type function fn))
557       (values       (values
558        (funcall fn 1)        (funcall fn 1)
559        (funcall fn 1 nil)        (funcall fn 1 nil)
# Line 554  Line 572 
572     (let ((fn (eval '(defgeneric defgeneric.fun.19 (x &key)     (let ((fn (eval '(defgeneric defgeneric.fun.19 (x &key)
573                        (:method ((x number) &key ((:bar foo) 'a foo-p))                        (:method ((x number) &key ((:bar foo) 'a foo-p))
574                                 (list x foo (notnot foo-p)))))))                                 (list x foo (notnot foo-p)))))))
575         (declare (type function fn))
576       (values       (values
577        (funcall fn 1)        (funcall fn 1)
578        (funcall fn 1 :bar nil)        (funcall fn 1 :bar nil)
# Line 569  Line 588 
588                                            (z (if y-p (1+ y) (+ x 10))                                            (z (if y-p (1+ y) (+ x 10))
589                                               z-p))                                               z-p))
590                                 (list x y (notnot y-p) z (notnot z-p)))))))                                 (list x y (notnot y-p) z (notnot z-p)))))))
591         (declare (type function fn))
592       (values       (values
593        (funcall fn 1)        (funcall fn 1)
594        (funcall fn 1 5)        (funcall fn 1 5)
# Line 584  Line 604 
604                                  (z (if y-p (1+ y) (+ x 10))                                  (z (if y-p (1+ y) (+ x 10))
605                                     z-p))                                     z-p))
606                                 (list x y (notnot y-p) z (notnot z-p)))))))                                 (list x y (notnot y-p) z (notnot z-p)))))))
607         (declare (type function fn))
608       (values       (values
609        (funcall fn 1)        (funcall fn 1)
610        (funcall fn 1 :y 5)        (funcall fn 1 :y 5)
# Line 600  Line 621 
621     (let ((fn (eval '(defgeneric defgeneric.fun.22 (x &key)     (let ((fn (eval '(defgeneric defgeneric.fun.22 (x &key)
622                        (:method ((x number) &key ((:allow-other-keys y)))                        (:method ((x number) &key ((:allow-other-keys y)))
623                                 (list x y))))))                                 (list x y))))))
624         (declare (type function fn))
625       (values       (values
626        (funcall fn 1)        (funcall fn 1)
627        (funcall fn 1 :allow-other-keys nil)        (funcall fn 1 :allow-other-keys nil)
# Line 624  Line 646 
646     (let ((fn (eval '(defgeneric defgeneric.fun.23 (x)     (let ((fn (eval '(defgeneric defgeneric.fun.23 (x)
647                        (:method ((x number) &aux (y (1+ x))) (list x y))                        (:method ((x number) &aux (y (1+ x))) (list x y))
648                        (:method ((x symbol) &aux (z (list x))) (list x z))))))                        (:method ((x symbol) &aux (z (list x))) (list x z))))))
649         (declare (type function fn))
650       (values       (values
651        (funcall fn 1)        (funcall fn 1)
652        (funcall fn 'a)))        (funcall fn 'a)))
# Line 649  Line 672 
672                                  &aux (z (list x y (notnot y-p)                                  &aux (z (list x y (notnot y-p)
673                                                bar (notnot bar-p))))                                                bar (notnot bar-p))))
674                                 z)))))                                 z)))))
675        (declare (type function fn))
676      (values      (values
677       (funcall fn 'a)       (funcall fn 'a)
678       (funcall fn 'a 'b)       (funcall fn 'a 'b)
# Line 662  Line 686 
686                       (declare (optimize (safety 3)))                       (declare (optimize (safety 3)))
687                       (:method ((x symbol)) x)                       (:method ((x symbol)) x)
688                       (declare (optimize (debug 3)))))))                       (declare (optimize (debug 3)))))))
689        (declare (type function fn))
690      (funcall fn 'a))      (funcall fn 'a))
691    a)    a)
692    
# Line 675  Line 700 
700                         (:method ((x number) (y number)) (+ x y))                         (:method ((x number) (y number)) (+ x y))
701                         (:method ((x string) (y string))                         (:method ((x string) (y string))
702                                  (concatenate 'string x y))))))                                  (concatenate 'string x y))))))
703          (declare (type function fn))
704        (values        (values
705         (funcall fn 1 2)         (funcall fn 1 2)
706         (funcall fn "1" "2")))         (funcall fn "1" "2")))
# Line 686  Line 712 
712                       (:method ((x integer) &key foo) (list x foo))                       (:method ((x integer) &key foo) (list x foo))
713                       (:method ((x number) &key bar) (list x bar))                       (:method ((x number) &key bar) (list x bar))
714                       (:method ((x t) &key baz) (list x baz))))))                       (:method ((x t) &key baz) (list x baz))))))
715        (declare (type function fn))
716      (values      (values
717                
718       (funcall fn 1)       (funcall fn 1)
# Line 725  Line 752 
752           (eval '(defgeneric defgeneric.fun.29 (x &key)           (eval '(defgeneric defgeneric.fun.29 (x &key)
753                    (:method ((x defgeneric.29.class.1) &key foo) foo)                    (:method ((x defgeneric.29.class.1) &key foo) foo)
754                    (:method ((x defgeneric.29.class.2) &key bar) bar)))))                    (:method ((x defgeneric.29.class.2) &key bar) bar)))))
755        (declare (type function fn))
756      (let ((x (make-instance 'defgeneric.29.class.3)))      (let ((x (make-instance 'defgeneric.29.class.3)))
757        (values        (values
758         (funcall fn x)         (funcall fn x)
# Line 744  Line 772 
772                      (:generic-function-class substandard-generic-function)                      (:generic-function-class substandard-generic-function)
773                      (:method ((x symbol)) 1)                      (:method ((x symbol)) 1)
774                      (:method ((x integer)) 2)))))                      (:method ((x integer)) 2)))))
775          (declare (type function fn))
776        (values        (values
777         (typep* fn 'substandard-generic-function)         (typep* fn 'substandard-generic-function)
778         (typep* fn 'standard-generic-function)         (typep* fn 'standard-generic-function)
# Line 777  Line 806 
806                        (assert (null args)) (setf (car y) x))                        (assert (null args)) (setf (car y) x))
807               (:method (x (y array) &rest args)               (:method (x (y array) &rest args)
808                        (setf (apply #'aref y args) x))))))                        (setf (apply #'aref y args) x))))))
809        (declare (type function fn))
810      (values      (values
811       (let ((z (list 'a 'b)))       (let ((z (list 'a 'b)))
812         (list         (list
# Line 802  Line 832 
832                                "FOO"                                "FOO"
833                                (declare (optimize (safety 3)))                                (declare (optimize (safety 3)))
834                                x)))))                                x)))))
835        (declare (type function fn))
836      (values      (values
837       (funcall fn 'a)       (funcall fn 'a)
838       (let ((method (first (compute-applicable-methods fn '(a)))))       (let ((method (first (compute-applicable-methods fn '(a)))))

Legend:
Removed from v.1.17  
changed lines
  Added in v.1.18

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