;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Jul 13 08:26:41 2003
;;;; Contains: Tests of DEFINE-METHOD-COMBINATION (long form)



(eval-when (:load-toplevel :compile-toplevel :execute)
  (report-and-ignore-errors
   (defparameter *dmc-long-01*
     (define-method-combination mc-long-01 nil nil)))
  (report-and-ignore-errors
   (defgeneric dmc-long-gf-01 (x y) (:method-combination mc-long-01)))
  )

(deftest define-method-combination-long.01.1
  (eqt *dmc-long-01* 'mc-long-01)
  t)

;;; The list of method groups specifiers for this method combination
;;; is empty, so no methods are valid.
(deftest define-method-combination-long.01.2
  (progn
    (eval '(defmethod dmc-long-gf-01 ((x t) (y t)) :foo))
    (handler-case
     (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)

;;; :arguments option

(eval-when (:load-toplevel :compile-toplevel :execute)
  (report-and-ignore-errors
   (defparameter *dmc-long-11*
     (define-method-combination mc-long-11 () ((method-list *))
       (:arguments x1 &optional (y1 :y1 y1-supplied) &rest r1 &key (z1 :z1 z1-supplied))
       `(vector ,x1 ,y1 ,y1-supplied ,r1 ,z1 ,z1-supplied
                ,@(mapcar #'(lambda (m) `(call-method ,m)) method-list)))))
  (report-and-ignore-errors
   (defgeneric dmc-long-gf-11a () (:method-combination mc-long-11))
   (defgeneric dmc-long-gf-11b (x1 &optional y1 &key z1) (:method-combination mc-long-11))
   (defgeneric dmc-long-gf-11c (x1 &optional y1 &rest r1) (:method-combination mc-long-11)))
  )

(deftest define-method-combination-long.11.1
  (eqt *dmc-long-11* 'mc-long-11)
  t)

(deftest define-method-combination-long.11.2
    ;; excess required parameters in the :arguments lambda-list are bound to nil
  (progn
    (eval '(defmethod dmc-long-gf-11a () 'a))
    (values
     (dmc-long-gf-11a)))
  #(nil :y1 nil nil :z1 nil a))

(deftest define-method-combination-long.11.3
  (progn
    (eval '(defmethod dmc-long-gf-11b ((x (eql 1)) &optional y &key z1) 'a))
    (eval '(defmethod dmc-long-gf-11b ((x integer) &optional (y 2) &key z1) 'b))
    (values
     (dmc-long-gf-11b 0)
     (dmc-long-gf-11b 1)
     (dmc-long-gf-11b 0 0)
     (dmc-long-gf-11b 1 1)
     (dmc-long-gf-11b 1 1 :z1 4)))
  #(0 :y1 nil nil :z1 nil b) #(1 :y1 nil nil :z1 nil a b) #(0 0 t nil :z1 nil b) #(1 1 t nil :z1 nil a b)
  #(1 1 t (:z1 4) 4 t a b))

(deftest define-method-combination-long.11.4
  (progn
    (eval '(defmethod dmc-long-gf-11c ((x (eql 1)) &optional y &rest r1) 'a))
    (eval '(defmethod dmc-long-gf-11c ((x integer) &optional (y 2) &rest r1) 'b))
    (values
     (dmc-long-gf-11c 0)
     (dmc-long-gf-11c 1)
     (dmc-long-gf-11c 0 0)
     (dmc-long-gf-11c 1 1)
     (dmc-long-gf-11c 1 1 2 3)))
  #(0 :y1 nil nil :z1 nil b) #(1 :y1 nil nil :z1 nil a b) #(0 0 t nil :z1 nil b) #(1 1 t nil :z1 nil a b)
  #(1 1 t (2 3) :z1 nil a b))

(deftest define-method-combination-long.11.5
  (signals-error (dmc-long-gf-11b nil) error)
  t)