Commit dd3d0fe8 authored by pfdietz's avatar pfdietz

ADD-METHOD tests. Must still add tests for nonstandard or nonprimary methods.

parent 78471aa9
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Wed Jun 4 19:12:25 2003
;;;; Contains: Tests for ADD-METHOD
(in-package :cl-test)
(defgeneric add-method-gf-01 (x)
(:method ((x t)) 'a))
(defgeneric add-method-gf-02 (x))
;;; Cannot add a method that's already in another method
(deftest add-method.error.1
(let ((method (find-method #'add-method-gf-01 nil (list (find-class t)))))
(handler-case
(add-method #'add-method-gf-02 method)
(error () :error)))
:error)
;;; The lambda lists must be congruent
(deftest add-method.error.2
(let* ((gf (eval '(defgeneric add-method-gf-03 (x)
(:method ((x t)) 'a))))
(method (find-method #'add-method-gf-03 nil (list (find-class t))))
(gf2 (eval '(defgeneric add-method-gf-04 (x y)))))
(handler-case
(add-method gf2 method)
(error () :error)))
:error)
(deftest add-method.error.3
(let* ((gf (eval '(defgeneric add-method-gf-05 (x &optional y)
(:method ((x t) &optional y) 'a))))
(method (find-method #'add-method-gf-05 nil (list (find-class t))))
(gf2 (eval '(defgeneric add-method-gf-06 (x y)))))
(handler-case
(add-method gf2 method)
(error () :error)))
:error)
(deftest add-method.error.4
(classify-error (add-method))
program-error)
(deftest add-method.error.5
(classify-error (add-method #'add-method-gf-01))
program-error)
(deftest add-method.error.6
(classify-error
(let* ((gf (eval '(defgeneric add-method-gf-07 (x)
(:method ((x t)) 'a))))
(method (find-method #'add-method-gf-07 nil (list (find-class t))))
(gf2 (eval '(defgeneric add-method-gf-08 (x)))))
(remove-method gf method)
(add-method gf2 method nil)))
program-error)
(deftest add-method.error.7
(let* ((gf (eval '(defgeneric add-method-gf-09 (x y)
(:method ((x t) (y t)) 'a))))
(method (find-method #'add-method-gf-09 nil (list (find-class t)
(find-class t))))
(gf2 (eval '(defgeneric add-method-gf-10 (x &optional y)))))
(remove-method gf method)
(handler-case
(add-method gf2 method)
(error () :error)))
:error)
(deftest add-method.error.8
(let* ((gf (eval '(defgeneric add-method-gf-11 (x &key y)
(:method ((x t) &key y) 'a))))
(method (find-method #'add-method-gf-11 nil (list (find-class t))))
(gf2 (eval '(defgeneric add-method-gf-12 (x)))))
(remove-method gf method)
(handler-case
(add-method gf2 method)
(error () :error)))
:error)
;;; Non-error tests
(deftest add-method.1
(let* ((gf (eval '(defgeneric add-method-gf-13 (x)
(:method ((x integer)) 'a)
(:method ((x t)) 'b))))
(method (find-method #'add-method-gf-13
nil (list (find-class 'integer))))
(gf2 (eval '(defgeneric add-method-gf-14 (x)))))
(values
(funcall gf 0)
(funcall gf 'x)
(eqt gf (remove-method gf method))
(eqt gf2 (add-method gf2 method))
(funcall gf 0)
(funcall gf 'x)
(funcall gf2 0)))
a b t t b b a)
......@@ -47,3 +47,4 @@
(load "call-next-method.lsp")
(load "compute-applicable-methods.lsp")
(load "find-method.lsp")
(load "add-method.lsp")
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