define-method-combination.lsp 5.14 KB
Newer Older
1 2 3 4 5 6
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Jun 15 10:49:39 2003
;;;; Contains: Tests of DEFINE-METHOD-COMBINATION

(in-package :cl-test)
camm's avatar
camm committed
7

8 9 10 11 12 13 14 15 16
(defclass dmc-class-01a () ())
(defclass dmc-class-01b (dmc-class-01a) ())
(defclass dmc-class-01c (dmc-class-01a) ())
(defclass dmc-class-01d (dmc-class-01b dmc-class-01c) ())
(defclass dmc-class-01e (dmc-class-01c dmc-class-01b) ())
(defclass dmc-class-01f (dmc-class-01d) ())
(defclass dmc-class-01g (dmc-class-01a) ())
(defclass dmc-class-01h (dmc-class-01f dmc-class-01g) ())

17 18 19 20 21 22
(eval-when (:load-toplevel :compile-toplevel :execute)
  (report-and-ignore-errors
   (defvar *dmc-times*
     (define-method-combination times
       :documentation "Multiplicative method combination, version 1"
       :operator *))
sds's avatar
sds committed
23

24
   (defgeneric dmc-gf-01 (x) (:method-combination times))
sds's avatar
sds committed
25

26 27 28 29 30 31
   (defmethod dmc-gf-01 times ((x integer)) 2)
   (defmethod dmc-gf-01 times ((x rational)) 3)
   (defmethod dmc-gf-01 times ((x real)) 5)
   (defmethod dmc-gf-01 times ((x number)) 7)
   (defmethod dmc-gf-01 times ((x complex)) 11)
   ))
32 33 34 35 36 37 38 39 40 41 42 43

(deftest define-method-combination-01.1
  (values
   (dmc-gf-01 1)
   (dmc-gf-01 1/2)
   (dmc-gf-01 1.0)
   (dmc-gf-01 #c(1 2)))
  210 105 35 77)

(deftest define-method-combination-01.2
  (handler-case
   (eval '(locally (declare (optimize (safety 3)))
sds's avatar
sds committed
44
                   (dmc-gf-01 'x)))
45 46 47
   (error () :good))
  :good)

48 49 50 51
(deftest define-method-combination-01.3
  *dmc-times*
  times)

52 53 54
(deftest define-method-combination-01.4
  (let ((doc (documentation *dmc-times* 'method-combination)))
    (or (null doc)
sds's avatar
sds committed
55 56
        (equalt doc "Multiplicative method combination, version 1")))
  t)
57

58 59 60
(eval-when (:load-toplevel :compile-toplevel :execute)
  (report-and-ignore-errors
   (defgeneric dmc-gf-02 (x) (:method-combination times))
sds's avatar
sds committed
61

62 63 64 65 66 67
   (defmethod dmc-gf-02 times ((x integer)) 2)
   (defmethod dmc-gf-02 :around ((x rational)) (1- (call-next-method)))
   (defmethod dmc-gf-02 times ((x real)) 3)
   (defmethod dmc-gf-02 times ((x number)) 5)
   (defmethod dmc-gf-02 :around ((x (eql 1.0s0))) 1)
   ))
68 69 70 71 72 73 74 75 76 77

(deftest define-method-combination-02.1
  (values
   (dmc-gf-02 1)
   (dmc-gf-02 1/3)
   (dmc-gf-02 1.0s0)
   (dmc-gf-02 13.0)
   (dmc-gf-02 #c(1 2)))
  29 14 1 15 5)

78 79 80
(eval-when (:load-toplevel :compile-toplevel :execute)
  (report-and-ignore-errors
   (defgeneric dmc-gf-03 (x) (:method-combination times))))
81 82

(deftest define-method-combination-03.1
83 84 85
  (prog1
      (handler-case
       (progn
sds's avatar
sds committed
86 87 88
         (eval '(defmethod dmc-gf-03 ((x integer)) t))
         (eval '(dmc-gf-03 1))
         :bad)
89 90 91
       (error () :good))
    (dolist (meth (compute-applicable-methods #'dmc-gf-03 (list 1)))
      (remove-method #'dmc-gf-03 meth)))
92 93 94
  :good)

(deftest define-method-combination-03.2
95 96 97
  (prog1
      (handler-case
       (progn
sds's avatar
sds committed
98 99 100
         (eval '(defmethod dmc-gf-03 :before ((x cons)) t))
         (eval '(dmc-gf-03 (cons 'a 'b)))
         :bad)
101 102 103
       (error () :good))
    (dolist (meth (compute-applicable-methods #'dmc-gf-03 (list '(a))))
      (remove-method #'dmc-gf-03 meth)))
104 105 106
  :good)

(deftest define-method-combination-03.3
107 108 109
  (prog1
      (handler-case
       (progn
sds's avatar
sds committed
110 111 112
         (eval '(defmethod dmc-gf-03 :after ((x symbol)) t))
         (eval '(dmc-gf-03 'a))
         :bad)
113 114 115
       (error () :good))
    (dolist (meth (compute-applicable-methods #'dmc-gf-03 (list 'a)))
      (remove-method #'dmc-gf-03 meth)))
116
  :good)
camm's avatar
camm committed
117

118 119 120 121 122
(eval-when (:load-toplevel :compile-toplevel :execute)
  (report-and-ignore-errors
   (define-method-combination times2
     :operator *
     :identity-with-one-argument t)
sds's avatar
sds committed
123

124
   (defgeneric dmc-gf-04 (x) (:method-combination times2))
sds's avatar
sds committed
125

126 127 128 129 130
   (defmethod dmc-gf-04 times2 ((x dmc-class-01b)) 2)
   (defmethod dmc-gf-04 times2 ((x dmc-class-01c)) 3)
   (defmethod dmc-gf-04 times2 ((x dmc-class-01d)) 5)
   (defmethod dmc-gf-04 times2 ((x symbol)) nil)
   ))
131

132 133 134
(deftest define-method-combination-04.1
  (dmc-gf-04 (make-instance 'dmc-class-01h))
  30)
135

136 137 138
(deftest define-method-combination-04.2
  (dmc-gf-04 (make-instance 'dmc-class-01e))
  6)
139

140 141 142
(deftest define-method-combination-04.3
  (dmc-gf-04 'a)
  nil)
143 144 145 146 147 148 149 150

(eval-when (:load-toplevel :compile-toplevel :execute)
  (report-and-ignore-errors
   (defvar *dmc-times-5*
     (define-method-combination times-5 :operator *))))

(deftest define-method-combination-05.1
  (let* ((doc1 (setf (documentation *dmc-times-5* 'method-combination)
sds's avatar
sds committed
151 152
                     "foo"))
         (doc2 (documentation *dmc-times-5* 'method-combination)))
153 154 155
    (values
     doc1
     (or (null doc2)
sds's avatar
sds committed
156
         (equalt doc2 "foo"))))
157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181
  "foo" t)

;; Operator name defaults to the method combination name.

(eval-when (:load-toplevel :compile-toplevel :execute)
  (defun times-7 (&rest args) (apply #'* args))
  (report-and-ignore-errors
   (defvar *dmc-times-7*
     (define-method-combination times-7))
   (defgeneric dmc-gf-07 (x) (:method-combination times))

   (defmethod dmc-gf-07 times ((x integer)) 2)
   (defmethod dmc-gf-07 times ((x rational)) 3)
   (defmethod dmc-gf-07 times ((x real)) 5)
   (defmethod dmc-gf-07 times ((x number)) 7)
   (defmethod dmc-gf-07 times ((x complex)) 11)
   ))

(deftest define-method-combination-07.1
  (values
   (dmc-gf-07 1)
   (dmc-gf-07 1/2)
   (dmc-gf-07 1.0)
   (dmc-gf-07 #c(1 2)))
  210 105 35 77)