source: trunk/source/tests/ansi-tests/add-method.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 3.9 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Wed Jun  4 19:12:25 2003
4;;;; Contains: Tests for ADD-METHOD
5
6(in-package :cl-test)
7
8(defgeneric add-method-gf-01 (x)
9  (:method ((x t)) 'a))
10
11(defgeneric add-method-gf-02 (x))
12
13;;; Cannot add a method that's already in another method
14
15(deftest add-method.error.1
16  (let ((method (find-method #'add-method-gf-01 nil (list (find-class t)))))
17    (handler-case
18     (add-method #'add-method-gf-02 method)
19     (error () :error)))
20  :error)
21
22;;; The lambda lists must be congruent
23
24(deftest add-method.error.2
25  (let* ((gf (eval '(defgeneric add-method-gf-03 (x)
26                      (:method ((x t)) 'a))))
27         (method (find-method #'add-method-gf-03 nil (list (find-class t))))
28         (gf2 (eval '(defgeneric add-method-gf-04 (x y)))))
29    (handler-case
30     (add-method gf2 method)
31     (error () :error)))
32  :error)
33
34(deftest add-method.error.3
35  (let* ((gf (eval '(defgeneric add-method-gf-05 (x &optional y)
36                      (:method ((x t) &optional y) 'a))))
37         (method (find-method #'add-method-gf-05 nil (list (find-class t))))
38         (gf2 (eval '(defgeneric add-method-gf-06 (x y)))))
39    (handler-case
40     (add-method gf2 method)
41     (error () :error)))
42  :error)
43
44(deftest add-method.error.4
45  (signals-error (add-method) program-error)
46  t)
47
48(deftest add-method.error.5
49  (signals-error (add-method #'add-method-gf-01) program-error)
50  t)
51
52(deftest add-method.error.6
53  (signals-error
54   (let* ((gf (eval '(defgeneric add-method-gf-07 (x)
55                       (:method ((x t)) 'a))))
56          (method (find-method #'add-method-gf-07 nil (list (find-class t))))
57          (gf2 (eval '(defgeneric add-method-gf-08 (x)))))
58     (remove-method gf method)
59     (add-method gf2 method nil))
60   program-error)
61  t)
62
63(deftest add-method.error.7
64  (let* ((gf (eval '(defgeneric add-method-gf-09 (x y)
65                      (:method ((x t) (y t)) 'a))))
66         (method (find-method #'add-method-gf-09 nil (list (find-class t)
67                                                           (find-class t))))
68         (gf2 (eval '(defgeneric add-method-gf-10 (x &optional y)))))
69     (remove-method gf method)
70     (handler-case
71      (add-method gf2 method)
72      (error () :error)))
73  :error)
74
75(deftest add-method.error.8
76  (let* ((gf (eval '(defgeneric add-method-gf-11 (x &key y)
77                      (:method ((x t) &key y) 'a))))
78         (method (find-method #'add-method-gf-11 nil (list (find-class t))))
79         (gf2 (eval '(defgeneric add-method-gf-12 (x)))))
80    (remove-method gf method)
81    (handler-case
82     (add-method gf2 method)
83     (error () :error)))
84  :error)
85
86
87;;; Non-error tests
88
89(deftest add-method.1
90  (let* ((gf (eval '(defgeneric add-method-gf-13 (x)
91                      (:method ((x integer)) 'a)
92                      (:method ((x t)) 'b))))
93         (method (find-method #'add-method-gf-13
94                              nil (list (find-class 'integer))))
95         (gf2 (eval '(defgeneric add-method-gf-14 (x)))))
96    (declare (type generic-function gf gf2))
97    (values
98     (funcall gf 0)
99     (funcall gf 'x)
100     (eqt gf (remove-method gf method))
101     (eqt gf2 (add-method gf2 method))
102     (funcall gf 0)
103     (funcall gf 'x)
104     (funcall gf2 0)))
105  a b t t b b a)
106
107;;; An existing method is replaced.
108
109(deftest add-method.2
110  (let* ((specializers (list (find-class 'integer)))
111         (gf (eval '(defgeneric add-method-gf-15 (x)
112                      (:method ((x integer)) 'a)
113                      (:method ((x t)) 'b))))
114         (method (find-method gf nil specializers))
115         (gf2 (eval '(defgeneric add-method-gf-16 (x)
116                       (:method ((x integer)) 'c)
117                       (:method ((x t)) 'd))))
118         (method2 (find-method gf2 nil specializers)))
119    (declare (type generic-function gf gf2))
120    (values
121     (funcall gf 0)
122     (funcall gf 'x)
123     (funcall gf2 0)
124     (funcall gf2 'x)
125     (eqt gf (remove-method gf method))
126     (eqt gf2 (add-method gf2 method))
127     (eqt method (find-method gf2 nil specializers))
128     (eqt method2 (find-method gf2 nil specializers))
129     (funcall gf 0)
130     (funcall gf 'x)
131     (funcall gf2 0)
132     (funcall gf2 'x)))
133  a b c d t t t nil b b a d)
134
135;;; Must add tests for: :around methods, :before methods, :after methods,
136;;; nonstandard method combinations
Note: See TracBrowser for help on using the repository browser.