diff --git a/ansi-tests/define-method-combination-long-form.lsp b/ansi-tests/define-method-combination-long-form.lsp index 7c0601940b555e912447cf64b229dda2b6759eb6..28eb4867a2b24db14b6e8556d34dffd59b82969f 100644 --- a/ansi-tests/define-method-combination-long-form.lsp +++ b/ansi-tests/define-method-combination-long-form.lsp @@ -23,10 +23,289 @@ (progn (eval '(defmethod dmc-long-gf-01 ((x t) (y t)) :foo)) (handler-case - (dmc-long-gf-01 'a 'b) + (eval '(dmc-long-gf-01 'a 'b)) (error () :caught))) :caught) - +;;; A single method group with the * method group specifier + +(eval-when (:load-toplevel :compile-toplevel :execute) + (report-and-ignore-errors + (defparameter *dmc-long-02* + (define-method-combination mc-long-02 nil ((method-list *)) + `(vector ,@(mapcar #'(lambda (m) `(call-method ,m)) method-list))))) + (report-and-ignore-errors + (defgeneric dmc-long-gf-02 (x y) (:method-combination mc-long-02))) + ) + +(deftest define-method-combination-long.02.1 + (eqt *dmc-long-02* 'mc-long-02) + t) + +(deftest define-method-combination-long.02.2 + (progn + (eval '(defmethod dmc-long-gf-02 ((x (eql 1)) (y integer)) 'a)) + (eval '(defmethod dmc-long-gf-02 ((x integer) (y (eql 2))) 'b)) + (eval '(defmethod dmc-long-gf-02 ((x integer) (y integer)) 'z)) + (values + (dmc-long-gf-02 0 0) + (dmc-long-gf-02 1 0) + (dmc-long-gf-02 0 2) + (dmc-long-gf-02 1 2))) + #(z) #(a z) #(b z) #(a b z)) + +(deftest define-method-combination-long.02.3 + (signals-error (dmc-long-gf-02 nil nil) error) + t) + +;;; Same, but with :order parameter. +;;; Also, :description with a format string + +(eval-when (:load-toplevel :compile-toplevel :execute) + (report-and-ignore-errors + (defparameter *dmc-long-03* + (define-method-combination mc-long-03 nil ((method-list * :order :most-specific-first + :description "This method has qualifiers ~A" + )) + `(vector ,@(mapcar #'(lambda (m) `(call-method ,m)) method-list))))) + (report-and-ignore-errors + (defgeneric dmc-long-gf-03 (x y) (:method-combination mc-long-03))) + ) + +(deftest define-method-combination-long.03.1 + (eqt *dmc-long-03* 'mc-long-03) + t) + +(deftest define-method-combination-long.03.2 + (progn + (eval '(defmethod dmc-long-gf-03 ((x (eql 1)) (y integer)) 'a)) + (eval '(defmethod dmc-long-gf-03 ((x integer) (y (eql 2))) 'b)) + (eval '(defmethod dmc-long-gf-03 ((x integer) (y integer)) 'z)) + (values + (dmc-long-gf-03 0 0) + (dmc-long-gf-03 1 0) + (dmc-long-gf-03 0 2) + (dmc-long-gf-03 1 2))) + #(z) #(a z) #(b z) #(a b z)) + +(deftest define-method-combination-long.03.3 + (signals-error (dmc-long-gf-03 nil nil) error) + t) + +;;; Same, but with :order parameter :most-specific-last +;;; (and testing that the :order parameter is evaluated) + +(eval-when (:load-toplevel :compile-toplevel :execute) + (report-and-ignore-errors + (defparameter *dmc-long-04* + (let ((order :most-specific-last)) + (define-method-combination mc-long-04 nil ((method-list * :order order)) + `(vector ,@(mapcar #'(lambda (m) `(call-method ,m)) method-list)))))) + (report-and-ignore-errors + (defgeneric dmc-long-gf-04 (x y) (:method-combination mc-long-04))) + ) + +(deftest define-method-combination-long.04.1 + (eqt *dmc-long-04* 'mc-long-04) + t) + +(deftest define-method-combination-long.04.2 + (progn + (eval '(defmethod dmc-long-gf-04 ((x (eql 1)) (y integer)) 'a)) + (eval '(defmethod dmc-long-gf-04 ((x integer) (y (eql 2))) 'b)) + (eval '(defmethod dmc-long-gf-04 ((x integer) (y integer)) 'z)) + (values + (dmc-long-gf-04 0 0) + (dmc-long-gf-04 1 0) + (dmc-long-gf-04 0 2) + (dmc-long-gf-04 1 2))) + #(z) #(z a) #(z b) #(z b a)) + +(deftest define-method-combination-long.04.3 + (signals-error (dmc-long-gf-04 nil nil) error) + t) + +;;; Empty qualifier list + +(eval-when (:load-toplevel :compile-toplevel :execute) + (report-and-ignore-errors + (defparameter *dmc-long-05* + (define-method-combination mc-long-05 nil ((method-list nil) + (ignored-methods *)) + (declare (ignorable ignored-methods)) + `(vector ,@(mapcar #'(lambda (m) `(call-method ,m)) method-list))))) + (report-and-ignore-errors + (defgeneric dmc-long-gf-05 (x y) (:method-combination mc-long-05))) + ) + +(deftest define-method-combination-long.05.1 + (eqt *dmc-long-05* 'mc-long-05) + t) + +(deftest define-method-combination-long.05.2 + (progn + (eval '(defmethod dmc-long-gf-05 ((x (eql 1)) (y integer)) 'a)) + (eval '(defmethod dmc-long-gf-05 ((x integer) (y (eql 2))) 'b)) + (eval '(defmethod dmc-long-gf-05 ((x integer) (y integer)) 'z)) + (eval '(defmethod dmc-long-gf-05 foo ((x t) (y t)) 'bad)) + (values + (dmc-long-gf-05 nil nil) + (dmc-long-gf-05 0 0) + (dmc-long-gf-05 1 0) + (dmc-long-gf-05 0 2) + (dmc-long-gf-05 1 2))) + #() #(z) #(a z) #(b z) #(a b z)) + +;;; :required + +(eval-when (:load-toplevel :compile-toplevel :execute) + (report-and-ignore-errors + (defparameter *dmc-long-06* + (define-method-combination mc-long-06 nil ((method-list nil :required t) + (ignored-methods *)) + (declare (ignorable ignored-methods)) + `(vector ,@(mapcar #'(lambda (m) `(call-method ,m)) method-list))))) + (report-and-ignore-errors + (defgeneric dmc-long-gf-06 (x y) (:method-combination mc-long-06))) + ) + +(deftest define-method-combination-long.06.1 + (eqt *dmc-long-06* 'mc-long-06) + t) + +(deftest define-method-combination-long.06.2 + (progn + (eval '(defmethod dmc-long-gf-06 ((x (eql 1)) (y integer)) 'a)) + (eval '(defmethod dmc-long-gf-06 ((x integer) (y (eql 2))) 'b)) + (eval '(defmethod dmc-long-gf-06 ((x integer) (y integer)) 'z)) + (eval '(defmethod dmc-long-gf-06 foo ((x t) (y t)) 'bad)) + (values + (dmc-long-gf-06 0 0) + (dmc-long-gf-06 1 0) + (dmc-long-gf-06 0 2) + (dmc-long-gf-06 1 2))) + #(z) #(a z) #(b z) #(a b z)) + +(deftest define-method-combination-long.06.3 + (signals-error-always (dmc-long-gf-06 nil nil) error) + t t) + + +;;; Non-empty lambda lists + +(eval-when (:load-toplevel :compile-toplevel :execute) + (report-and-ignore-errors + (defparameter *dmc-long-07* + (define-method-combination mc-long-07 (p1 p2) ((method-list *)) + `(vector ',p1 ',p2 ,@(mapcar #'(lambda (m) `(call-method ,m)) method-list))))) + (report-and-ignore-errors + (defgeneric dmc-long-gf-07 (x y) (:method-combination mc-long-07 1 2))) + ) + +(deftest define-method-combination-long.07.1 + (eqt *dmc-long-07* 'mc-long-07) + t) + +(deftest define-method-combination-long.07.2 + (progn + (eval '(defmethod dmc-long-gf-07 ((x (eql 1)) (y integer)) 'a)) + (eval '(defmethod dmc-long-gf-07 ((x integer) (y (eql 2))) 'b)) + (eval '(defmethod dmc-long-gf-07 ((x integer) (y integer)) 'z)) + (values + (dmc-long-gf-07 0 0) + (dmc-long-gf-07 1 0) + (dmc-long-gf-07 0 2) + (dmc-long-gf-07 1 2))) + #(1 2 z) #(1 2 a z) #(1 2 b z) #(1 2 a b z)) + +(deftest define-method-combination-long.07.3 + (signals-error (dmc-long-gf-07 nil) error) + t) + +(eval-when (:load-toplevel :compile-toplevel :execute) + (report-and-ignore-errors + (defparameter *dmc-long-08* + (define-method-combination mc-long-08 (p1 &optional p2 p3) ((method-list *)) + `(vector ',p1 ',p2 ',p3 ,@(mapcar #'(lambda (m) `(call-method ,m)) method-list))))) + (report-and-ignore-errors + (defgeneric dmc-long-gf-08 (x y) (:method-combination mc-long-08 1 2))) + ) + +(deftest define-method-combination-long.08.1 + (eqt *dmc-long-08* 'mc-long-08) + t) + +(deftest define-method-combination-long.08.2 + (progn + (eval '(defmethod dmc-long-gf-08 ((x (eql 1)) (y integer)) 'a)) + (eval '(defmethod dmc-long-gf-08 ((x integer) (y (eql 2))) 'b)) + (eval '(defmethod dmc-long-gf-08 ((x integer) (y integer)) 'z)) + (values + (dmc-long-gf-08 0 0) + (dmc-long-gf-08 1 0) + (dmc-long-gf-08 0 2) + (dmc-long-gf-08 1 2))) + #(1 2 nil z) #(1 2 nil a z) #(1 2 nil b z) #(1 2 nil a b z)) + +(deftest define-method-combination-long.08.3 + (signals-error (dmc-long-gf-08 nil) error) + t) + +(eval-when (:load-toplevel :compile-toplevel :execute) + (report-and-ignore-errors + (defparameter *dmc-long-09* + (define-method-combination mc-long-09 (p1 &key p2 p3) ((method-list *)) + `(vector ',p1 ',p2 ',p3 ,@(mapcar #'(lambda (m) `(call-method ,m)) method-list))))) + (report-and-ignore-errors + (defgeneric dmc-long-gf-09 (x y) (:method-combination mc-long-09 1 :p3 3))) + ) + +(deftest define-method-combination-long.09.1 + (eqt *dmc-long-09* 'mc-long-09) + t) + +(deftest define-method-combination-long.09.2 + (progn + (eval '(defmethod dmc-long-gf-09 ((x (eql 1)) (y integer)) 'a)) + (eval '(defmethod dmc-long-gf-09 ((x integer) (y (eql 2))) 'b)) + (eval '(defmethod dmc-long-gf-09 ((x integer) (y integer)) 'z)) + (values + (dmc-long-gf-09 0 0) + (dmc-long-gf-09 1 0) + (dmc-long-gf-09 0 2) + (dmc-long-gf-09 1 2))) + #(1 nil 3 z) #(1 nil 3 a z) #(1 nil 3 b z) #(1 nil 3 a b z)) + +(deftest define-method-combination-long.09.3 + (signals-error (dmc-long-gf-09 nil) error) + t) + +(eval-when (:load-toplevel :compile-toplevel :execute) + (report-and-ignore-errors + (defparameter *dmc-long-10* + (define-method-combination mc-long-10 (p1 &rest p2) ((method-list *)) + `(vector ',p1 ',p2 ,@(mapcar #'(lambda (m) `(call-method ,m)) method-list))))) + (report-and-ignore-errors + (defgeneric dmc-long-gf-10 (x y) (:method-combination mc-long-10 1 2 3 4))) + ) + +(deftest define-method-combination-long.10.1 + (eqt *dmc-long-10* 'mc-long-10) + t) + +(deftest define-method-combination-long.10.2 + (progn + (eval '(defmethod dmc-long-gf-10 ((x (eql 1)) (y integer)) 'a)) + (eval '(defmethod dmc-long-gf-10 ((x integer) (y (eql 2))) 'b)) + (eval '(defmethod dmc-long-gf-10 ((x integer) (y integer)) 'z)) + (values + (dmc-long-gf-10 0 0) + (dmc-long-gf-10 1 0) + (dmc-long-gf-10 0 2) + (dmc-long-gf-10 1 2))) + #(1 (2 3 4) z) #(1 (2 3 4) a z) #(1 (2 3 4) b z) #(1 (2 3 4) a b z)) + +(deftest define-method-combination-long.10.3 + (signals-error (dmc-long-gf-10 nil) error) + t) - \ No newline at end of file