Commit 1df86fcb authored by pfdietz's avatar pfdietz
Browse files

More long form define-method-combination tests

parent 3fc41804
......@@ -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
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment