defmethod.lsp 6.94 KB
Newer Older
pfdietz's avatar
pfdietz committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Thu Jun  9 07:02:53 2005
;;;; Contains: Separate tests for DEFMETHOD

(in-package :cl-test)

(deftest defmethod.1
  (let ((sym (gensym)))
    (values
     (typep* (eval `(defmethod ,sym (x) (list x))) 'standard-method)
     (typep* (fdefinition sym) 'standard-generic-function)
     (funcall sym 1)))
  t t (1))

(deftest defmethod.2
  (let* ((sym (gensym))
sds's avatar
sds committed
18 19
         (method
          (eval `(defmethod ,sym ((x integer)) (list x)))))
pfdietz's avatar
pfdietz committed
20 21 22 23 24 25 26 27
    (values
     (typep* method 'standard-method)
     (typep* (fdefinition sym) 'standard-generic-function)
     (funcall sym 1)))
  t t (1))

(deftest defmethod.3
  (let* ((sym (gensym))
sds's avatar
sds committed
28 29
         (method
          (eval `(let ((x 0)) (defmethod ,sym ((x (eql (incf x)))) (list x))))))
pfdietz's avatar
pfdietz committed
30 31 32 33 34 35 36
    (values
     (typep* method 'standard-method)
     (typep* (fdefinition sym) 'standard-generic-function)
     (funcall sym 1)
     (funcall sym 1)))
  t t (1) (1))

pfdietz's avatar
pfdietz committed
37 38
(deftest defmethod.4
  (let* ((sym (gensym))
sds's avatar
sds committed
39 40
         (method
          (eval `(defmethod (setf ,sym) ((x t) (y cons)) (setf (car y) x)))))
pfdietz's avatar
pfdietz committed
41 42 43 44 45 46 47 48 49
    (values
     (typep* method 'standard-method)
     (fboundp sym)
     (typep* (fdefinition `(setf ,sym)) 'standard-generic-function)
     (let ((x (cons 1 2))) (list (funcall (fdefinition `(setf ,sym)) 3 x) x))))
  t nil t (3 (3 . 2)))

(deftest defmethod.5
  (let* ((sym (gensym))
sds's avatar
sds committed
50 51
         (method
          (eval `(defmethod ,sym ((x integer)) (return-from ,sym (list x))))))
pfdietz's avatar
pfdietz committed
52 53 54 55 56 57 58 59
    (values
     (typep* method 'standard-method)
     (typep* (fdefinition sym) 'standard-generic-function)
     (funcall sym 1)))
  t t (1))

(deftest defmethod.6
  (let* ((sym (gensym))
sds's avatar
sds committed
60 61
         (method
          (eval `(defmethod (setf ,sym) ((x t) (y cons)) (return-from ,sym (setf (car y) x))))))
pfdietz's avatar
pfdietz committed
62 63 64 65 66 67 68 69 70
    (values
     (typep* method 'standard-method)
     (fboundp sym)
     (typep* (fdefinition `(setf ,sym)) 'standard-generic-function)
     (let ((x (cons 1 2))) (list (funcall (fdefinition `(setf ,sym)) 3 x) x))))
  t nil t (3 (3 . 2)))

(deftest defmethod.7
  (let* ((sym (gensym))
sds's avatar
sds committed
71 72
         (method
          (eval `(defmethod ,sym ((x integer) &aux (y (list x))) y))))
pfdietz's avatar
pfdietz committed
73 74 75 76 77 78 79 80
    (values
     (typep* method 'standard-method)
     (typep* (fdefinition sym) 'standard-generic-function)
     (funcall sym 1)))
  t t (1))

(deftest defmethod.8
  (let* ((sym (gensym))
sds's avatar
sds committed
81
         (method (eval `(defmethod ,sym ((x integer) &key z) (list x z)))))
pfdietz's avatar
pfdietz committed
82 83 84 85 86 87 88 89 90 91 92 93 94
    (values
     (typep* method 'standard-method)
     (typep* (fdefinition sym) 'standard-generic-function)
     (funcall sym 1)
     (funcall sym 2 :z 3)
     (funcall sym 4 :allow-other-keys nil)
     (funcall sym 5 :allow-other-keys t :bogus 17)
     (funcall sym 6 :allow-other-keys t :allow-other-keys nil :bogus 17)
     ))
  t t (1 nil) (2 3) (4 nil) (5 nil) (6 nil))

(deftest defmethod.9
  (let* ((sym (gensym))
sds's avatar
sds committed
95
         (method (eval `(defmethod ,sym ((x integer) &key (z :missing)) (list x z)))))
pfdietz's avatar
pfdietz committed
96 97 98 99 100 101 102 103 104 105 106
    (values
     (typep* method 'standard-method)
     (typep* (fdefinition sym) 'standard-generic-function)
     (funcall sym 1)
     (funcall sym 2 :z 3)
     (funcall sym 4 :allow-other-keys nil)
     ))
  t t (1 :missing) (2 3) (4 :missing))

(deftest defmethod.10
  (let* ((sym (gensym))
sds's avatar
sds committed
107
         (method (eval `(defmethod ,sym ((x integer) &key (z :missing z-p)) (list x z (notnot z-p))))))
pfdietz's avatar
pfdietz committed
108 109 110 111 112 113 114 115 116 117 118
    (values
     (typep* method 'standard-method)
     (typep* (fdefinition sym) 'standard-generic-function)
     (funcall sym 1)
     (funcall sym 2 :z 3)
     (funcall sym 4 :allow-other-keys nil)
     ))
  t t (1 :missing nil) (2 3 t) (4 :missing nil))

(deftest defmethod.11
  (let* ((sym (gensym))
sds's avatar
sds committed
119
         (method (eval `(defmethod ,sym ((x integer) &rest z) (list x z)))))
pfdietz's avatar
pfdietz committed
120 121 122 123 124 125 126
    (values
     (typep* method 'standard-method)
     (typep* (fdefinition sym) 'standard-generic-function)
     (funcall sym 1)
     (funcall sym 2 3)
     ))
  t t (1 nil) (2 (3)))
pfdietz's avatar
pfdietz committed
127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 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 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203

;;; Error cases

;;; Lambda liss not congruent

(deftest defmethod.error.1
  (let ((sym (gensym)))
    (eval `(defgeneric ,sym (x y)))
    (eval `(signals-error (defmethod ,sym ((x t)) x) error)))
  t)

(deftest defmethod.error.2
  (let ((sym (gensym)))
    (eval `(defgeneric ,sym (x y)))
    (eval `(signals-error (defmethod ,sym ((x t) (y t) (z t)) (list x y z)) error)))
  t)

(deftest defmethod.error.3
  (let ((sym (gensym)))
    (eval `(defgeneric ,sym (x y &optional z)))
    (eval `(signals-error (defmethod ,sym ((x t) (y t) (z t)) (list x y z)) error)))
  t)

(deftest defmethod.error.4
  (let ((sym (gensym)))
    (eval `(defgeneric ,sym (x y &optional z)))
    (eval `(signals-error (defmethod ,sym ((x t) (y t) &optional) (list x y)) error)))
  t)

(deftest defmethod.error.5
  (let ((sym (gensym)))
    (eval `(defgeneric ,sym (x y &optional z)))
    (eval `(signals-error (defmethod ,sym ((x t) (y t) &optional z w) (list x y z w)) error)))
  t)

(deftest defmethod.error.6
  (let ((sym (gensym)))
    (eval `(defgeneric ,sym (x &rest z)))
    (eval `(signals-error (defmethod ,sym ((x t)) (list x)) error)))
  t)

(deftest defmethod.error.7
  (let ((sym (gensym)))
    (eval `(defgeneric ,sym (x)))
    (eval `(signals-error (defmethod ,sym ((x t) &rest z) (list x z)) error)))
  t)

(deftest defmethod.error.8
  (let ((sym (gensym)))
    (eval `(defgeneric ,sym (x &key z)))
    (eval `(signals-error (defmethod ,sym ((x t)) (list x)) error)))
  t)

(deftest defmethod.error.9
  (let ((sym (gensym)))
    (eval `(defgeneric ,sym (x)))
    (eval `(signals-error (defmethod ,sym ((x t) &key z) (list x z)) error)))
  t)

(deftest defmethod.error.10
  (let ((sym (gensym)))
    (eval `(defgeneric ,sym (x &key z)))
    (eval `(signals-error (defmethod ,sym ((x t) &key) x) error)))
  t)

(deftest defmethod.error.11
  (let ((sym (gensym)))
    (eval `(defgeneric ,sym (x &key)))
    (eval `(signals-error (defmethod ,sym ((x t)) x) error)))
  t)

(deftest defmethod.error.12
  (let ((sym (gensym)))
    (eval `(defgeneric ,sym (x)))
    (eval `(signals-error (defmethod ,sym ((x t) &key) x) error)))
  t)

pfdietz's avatar
pfdietz committed
204 205 206 207 208
;;; Calling the implicitly defined generic function

(deftest defmethod.error.13
  (let ((sym (gensym)))
    (eval `(locally (declare (optimize safety)) (defmethod ,sym ((x t)) x)))
pfdietz's avatar
pfdietz committed
209
    (values (eval `(signals-error (,sym) program-error))
sds's avatar
sds committed
210
            (eval `(signals-error (,sym 1 2) program-error))))
pfdietz's avatar
pfdietz committed
211
  t t)
pfdietz's avatar
pfdietz committed
212

213 214 215 216
(deftest defmethod.error.14
  (let ((sym (gensym)))
    (eval `(locally (declare (optimize safety)) (defmethod ,sym ((x t) &key) x)))
    (values (eval `(signals-error (,sym) program-error))
sds's avatar
sds committed
217 218 219
            (eval `(signals-error (,sym 1 2) program-error))
            (eval `(signals-error (,sym 1 :bogus t) program-error))
            (eval `(signals-error (,sym 1 :allow-other-keys nil :allow-other-keys t :bogus t) program-error))))
220
  t t t t)
pfdietz's avatar
pfdietz committed
221

222 223 224 225
(deftest defmethod.error.15
  (let ((sym (gensym)))
    (eval `(locally (declare (optimize safety)) (defmethod ,sym ((x t) &key y) x)))
    (values (eval `(signals-error (,sym 1 :bogus t) program-error))
sds's avatar
sds committed
226 227
            (eval `(signals-error (,sym 1 :y) program-error))
            (eval `(signals-error (,sym 1 3 nil) program-error))))
228
  t t t)
pfdietz's avatar
pfdietz committed
229 230