defgeneric-method-combination-min.lsp 6.67 KB
Newer Older
1 2 3 4 5 6 7 8 9
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat May 24 21:31:55 2003
;;;; Contains: Tests of DEFGENERIC with :method-combination MIN

(in-package :cl-test)

(declaim (special *x*))

10 11
(compile-and-load "defgeneric-method-combination-aux.lsp")

12 13
(deftest defgeneric-method-combination.min.1
  (let ((*x* nil)
sds's avatar
sds committed
14 15 16 17 18 19 20
        (fn
         (eval '(defgeneric dg-mc.fun.min.1 (x)
                  (:method-combination min)
                  (:method min ((x integer)) (car (push 1 *x*)))
                  (:method min ((x rational)) (car (push 2 *x*)))
                  (:method min ((x number)) (car (push 3 *x*)))
                  (:method min ((x t)) (car (push 4 *x*)))))))
21
    (declare (type generic-function fn))
22
    (flet ((%f (y)
sds's avatar
sds committed
23 24
               (let ((*x* nil))
                 (list (funcall fn y) *x*))))
25 26 27 28 29
    (values (%f 1) (%f 2/3) (%f 1.54) (%f 'a))))
  (1 (4 3 2 1)) (2 (4 3 2)) (3 (4 3)) (4 (4)))

(deftest defgeneric-method-combination.min.2
  (let ((*x* nil)
sds's avatar
sds committed
30 31 32 33 34 35 36
        (fn
         (eval '(defgeneric dg-mc.fun.min.2 (x)
                  (:method-combination min :most-specific-first)
                  (:method min ((x integer)) (car (push 1 *x*)))
                  (:method min ((x rational)) (car (push 2 *x*)))
                  (:method min ((x number)) (car (push 3 *x*)))
                  (:method min ((x t)) (car (push 4 *x*)))))))
37
    (declare (type generic-function fn))
38
    (flet ((%f (y)
sds's avatar
sds committed
39 40
               (let ((*x* nil))
                 (list (funcall fn y) *x*))))
41 42 43 44 45
    (values (%f 1) (%f 2/3) (%f 1.54) (%f 'a))))
  (1 (4 3 2 1)) (2 (4 3 2)) (3 (4 3)) (4 (4)))

(deftest defgeneric-method-combination.min.3
  (let ((*x* nil)
sds's avatar
sds committed
46 47 48 49 50 51 52
        (fn
         (eval '(defgeneric dg-mc.fun.min.3 (x)
                  (:method-combination min :most-specific-last)
                  (:method min ((x integer)) (car (push 1 *x*)))
                  (:method min ((x rational)) (car (push 2 *x*)))
                  (:method min ((x number)) (car (push 3 *x*)))
                  (:method min ((x t)) (car (push 4 *x*)))))))
53
    (declare (type generic-function fn))
54
    (flet ((%f (y)
sds's avatar
sds committed
55 56
               (let ((*x* nil))
                 (list (funcall fn y) *x*))))
57 58 59 60 61
    (values (%f 1) (%f 2/3) (%f 1.54) (%f 'a))))
  (1 (1 2 3 4)) (2 (2 3 4)) (3 (3 4)) (4 (4)))

(deftest defgeneric-method-combination.min.4
  (let ((fn
sds's avatar
sds committed
62 63 64 65 66 67 68
         (eval '(defgeneric dg-mc.min.4 (x)
                  (:method-combination min)
                  (:method min ((x integer)) 1)
                  (:method :around ((x rational)) 'foo)
                  (:method min ((x number)) 2)
                  (:method min ((x symbol)) 3)
                  (:method min ((x t)) 4)))))
69
    (declare (type generic-function fn))
70 71 72 73 74 75 76 77 78 79
    (values
     (funcall fn 0)
     (funcall fn 4/3)
     (funcall fn 1.54)
     (funcall fn 'x)
     (funcall fn '(a b c))))
  foo foo 2 3 4)

(deftest defgeneric-method-combination.min.5
  (let ((fn
sds's avatar
sds committed
80 81 82 83 84 85 86 87
         (eval '(defgeneric dg-mc.min.5 (x)
                  (:method-combination min)
                  (:method min ((x integer)) 1)
                  (:method :around ((x rational))
                           (list 'foo (call-next-method)))
                  (:method min ((x number)) 2)
                  (:method min ((x symbol)) 4)
                  (:method min ((x t)) 8)))))
88
    (declare (type generic-function fn))
89 90 91 92 93 94 95 96 97 98
    (values
     (funcall fn 0)
     (funcall fn 4/3)
     (funcall fn 1.54)
     (funcall fn 'x)
     (funcall fn '(a b c))))
  (foo 1) (foo 2) 2 4 8)

(deftest defgeneric-method-combination.min.6
  (let ((fn
sds's avatar
sds committed
99 100 101 102 103 104 105 106 107 108
         (eval '(defgeneric dg-mc.min.6 (x)
                  (:method-combination min)
                  (:method min ((x integer)) 1)
                  (:method :around ((x rational))
                           (list 'foo (call-next-method)))
                  (:method :around ((x real))
                           (list 'bar (call-next-method)))
                  (:method min ((x number)) 2)
                  (:method min ((x symbol)) 4)
                  (:method min ((x t)) 8)))))
109
    (declare (type generic-function fn))
110 111 112 113 114 115 116 117 118 119 120
    (values
     (funcall fn 0)
     (funcall fn 4/3)
     (funcall fn 1.54)
     (funcall fn #c(1.0 2.0))
     (funcall fn 'x)
     (funcall fn '(a b c))))
  (foo (bar 1)) (foo (bar 2)) (bar 2) 2 4 8)

(deftest defgeneric-method-combination.min.7
  (let ((fn
sds's avatar
sds committed
121 122 123 124 125 126
         (eval '(defgeneric dg-mc.min.7 (x)
                  (:method-combination min)
                  (:method min ((x dgmc-class-04)) 1)
                  (:method min ((x dgmc-class-03)) 2)
                  (:method min ((x dgmc-class-02)) 4)
                  (:method min ((x dgmc-class-01)) 8)))))
127
    (declare (type generic-function fn))
128 129 130 131 132 133 134 135 136
    (values
     (funcall fn (make-instance 'dgmc-class-01))
     (funcall fn (make-instance 'dgmc-class-02))
     (funcall fn (make-instance 'dgmc-class-03))
     (funcall fn (make-instance 'dgmc-class-04))))
  8 4 2 1)

(deftest defgeneric-method-combination.min.8
  (let ((fn
sds's avatar
sds committed
137 138 139 140 141 142 143 144
         (eval '(defgeneric dg-mc.min.8 (x)
                  (:method-combination min)
                  (:method min ((x (eql 1000))) 0)
                  (:method :around ((x symbol)) (values))
                  (:method :around ((x integer)) (values 'a 'b 'c))
                  (:method :around ((x complex)) (call-next-method))
                  (:method :around ((x number)) (values 1 2 3 4 5 6))
                  (:method min ((x t)) 1)))))
145
    (declare (type generic-function fn))
146 147 148 149 150 151
    (values
     (multiple-value-list (funcall fn 'a))
     (multiple-value-list (funcall fn 10))
     (multiple-value-list (funcall fn #c(9 8)))
     (multiple-value-list (funcall fn '(a b c)))))
  () (a b c) (1 2 3 4 5 6) (1))
152 153 154 155

(deftest defgeneric-method-combination.min.9
  (handler-case
   (let ((fn (eval '(defgeneric dg-mc.min.9 (x)
sds's avatar
sds committed
156
                      (:method-combination min)))))
157
     (declare (type generic-function fn))
158 159 160 161 162
     (funcall fn (list 'a)))
   (error () :error))
  :error)

(deftest defgeneric-method-combination.min.10
163 164
  (progn
    (eval '(defgeneric dg-mc.min.10 (x)
sds's avatar
sds committed
165 166
             (:method-combination min)
             (:method ((x t)) 0)))
167 168 169
    (handler-case
     (dg-mc.min.10 'a)
     (error () :error)))
170 171 172
  :error)

(deftest defgeneric-method-combination.min.11
173 174
  (progn
    (eval '(defgeneric dg-mc.min.11 (x)
sds's avatar
sds committed
175 176
             (:method-combination min)
             (:method nonsense ((x t)) 0)))
177 178 179
    (handler-case
     (dg-mc.min.11 0)
     (error () :error)))
180 181 182 183
  :error)

(deftest defgeneric-method-combination.min.12
  (let ((fn (eval '(defgeneric dg-mc.min.12 (x)
sds's avatar
sds committed
184 185 186
                     (:method-combination min)
                     (:method :around ((x t)) 1)
                     (:method min ((x integer)) x)))))
187
    (declare (type generic-function fn))
188
    (handler-case (funcall fn 'a)
sds's avatar
sds committed
189
                  (error () :error)))
190 191
  :error)