/[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.12 by pfdietz, Sat May 24 18:13:18 2003 UTC revision 1.13 by pfdietz, Sat May 24 18:56:32 2003 UTC
# Line 193  Line 193 
193       (funcall fn 'x :foo 'a)))       (funcall fn 'x :foo 'a)))
194    program-error)    program-error)
195    
196    ;;;
197    
198    (deftest defgeneric.error.22
199      (progn
200        (defgeneric defgeneric-error-fn.22 (x))
201        (defmethod defgeneric-error-fn.22 ((x t)) nil)
202        (handler-case
203         (eval '(defgeneric defgeneric-error-fn.22 (x y)))
204         (error () :good)))
205      :good)
206    
207    
208    
209    
210  ;;; Non error cases  ;;; Non error cases
211    
# Line 644  Line 657 
657      (funcall fn 'a))      (funcall fn 'a))
658    a)    a)
659    
660  (defclass substandard-method (standard-method) ())  (when (subtypep (class-of (find-class 'standard-method))
661                    'standard-class)
662  (deftest defgeneric.27    (defclass substandard-method (standard-method) ())
663    (let ((fn (eval '(defgeneric defgeneric.fun.27 (x y)    (deftest defgeneric.27
664                       (:method-class substandard-method)      (let ((fn (eval '(defgeneric defgeneric.fun.27 (x y)
665                       (:method ((x number) (y number)) (+ x y))                         (:method-class substandard-method)
666                       (:method ((x string) (y string))                         (:method ((x number) (y number)) (+ x y))
667                                (concatenate 'string x y))))))                         (:method ((x string) (y string))
668      (values                                  (concatenate 'string x y))))))
669       (funcall fn 1 2)        (values
670       (funcall fn "1" "2")))         (funcall fn 1 2)
671    3 "12")         (funcall fn "1" "2")))
672        3 "12"))
673    
674  (deftest defgeneric.28  (deftest defgeneric.28
675    (let ((fn (eval '(defgeneric defgeneric.fun.28 (x &key)    (let ((fn (eval '(defgeneric defgeneric.fun.28 (x &key)
# Line 710  Line 724 
724         (funcall fn x :bar 'b :foo 'a))))         (funcall fn x :bar 'b :foo 'a))))
725    nil a nil a a)    nil a nil a a)
726    
727      (when (subtypep (class-of (find-class 'standard-generic-function))
728                    'standard-class)
729      (defclass substandard-generic-function (standard-generic-function) ())
730      (deftest defgeneric.30
731        (let ((fn
732               (eval '(defgeneric defgeneric.fun.29 (x)
733                        (:generic-function-class substandard-generic-function)
734                        (:method ((x symbol)) 1)
735                        (:method ((x integer)) 2)))))
736          (values
737           (typep* fn 'substandard-generic-function)
738           (typep* fn 'standard-generic-function)
739           (typep* fn 'generic-function)
740           (typep* fn 'function)
741           (funcall fn 'a)
742           (funcall fn 1)
743           (defgeneric.fun.29 'x)
744           (defgeneric.fun.29 12345678901234567890)))
745        t t t t 1 2 1 2))
746    
747    (deftest defgeneric.31
748      (progn
749        (defgeneric defgeneric.fun.31 (x) (:method ((x t)) t))
750        (defgeneric defgeneric.fun.31 (x y) (:method ((x t) (y t)) (list x y)))
751        (defgeneric.fun.31 'a 'b))
752      (a b))
753    
754    

Legend:
Removed from v.1.12  
changed lines
  Added in v.1.13

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