1 | ;-*- Mode: Lisp -*- |
---|
2 | ;;;; Author: Paul Dietz |
---|
3 | ;;;; Created: Mon Jun 2 06:40:41 2003 |
---|
4 | ;;;; Contains: Tests for COMPUTE-APPLICABLE-METHODS |
---|
5 | |
---|
6 | (in-package :cl-test) |
---|
7 | |
---|
8 | (defgeneric cam-gf-01 (x y)) |
---|
9 | |
---|
10 | (defparameter *cam-gf-01-method1* |
---|
11 | (defmethod cam-gf-01 ((x integer) (y integer)) 1)) |
---|
12 | |
---|
13 | (defparameter *cam-gf-01-method2* |
---|
14 | (defmethod cam-gf-01 ((x integer) (y t)) 2)) |
---|
15 | |
---|
16 | (defparameter *cam-gf-01-method3* |
---|
17 | (defmethod cam-gf-01 ((x t) (y integer)) 3)) |
---|
18 | |
---|
19 | (defparameter *cam-gf-01-method4* |
---|
20 | (defmethod cam-gf-01 ((x t) (y t)) 4)) |
---|
21 | |
---|
22 | (deftest compute-applicable-methods.1 |
---|
23 | (let ((methods (compute-applicable-methods #'cam-gf-01 (list 1 2)))) |
---|
24 | (equalt methods |
---|
25 | (list *cam-gf-01-method1* *cam-gf-01-method2* |
---|
26 | *cam-gf-01-method3* *cam-gf-01-method4*))) |
---|
27 | t) |
---|
28 | |
---|
29 | (deftest compute-applicable-methods.2 |
---|
30 | (let ((methods (compute-applicable-methods #'cam-gf-01 (list 1 'x)))) |
---|
31 | (equalt methods |
---|
32 | (list *cam-gf-01-method2* *cam-gf-01-method4*))) |
---|
33 | t) |
---|
34 | |
---|
35 | (deftest compute-applicable-methods.3 |
---|
36 | (let ((methods (compute-applicable-methods #'cam-gf-01 (list 'x 10)))) |
---|
37 | (equalt methods |
---|
38 | (list *cam-gf-01-method3* *cam-gf-01-method4*))) |
---|
39 | t) |
---|
40 | |
---|
41 | (deftest compute-applicable-methods.4 |
---|
42 | (let ((methods (compute-applicable-methods #'cam-gf-01 (list 'x 'y)))) |
---|
43 | (equalt methods (list *cam-gf-01-method4*))) |
---|
44 | t) |
---|
45 | |
---|
46 | (defgeneric cam-gf-02 (x)) |
---|
47 | |
---|
48 | (deftest compute-applicable-methods.5 |
---|
49 | (compute-applicable-methods #'cam-gf-02 '(1)) |
---|
50 | nil) |
---|
51 | |
---|
52 | (eval-when (:load-toplevel :compile-toplevel :execute) |
---|
53 | (report-and-ignore-errors |
---|
54 | (defgeneric cam-gf-03 (x) |
---|
55 | (:method-combination + :most-specific-first)) |
---|
56 | |
---|
57 | (defparameter *cam-gf-03-method1* |
---|
58 | (defmethod cam-gf-03 + ((x integer)) 1)) |
---|
59 | |
---|
60 | (defparameter *cam-gf-03-method2* |
---|
61 | (defmethod cam-gf-03 + ((x rational)) 2)) |
---|
62 | |
---|
63 | (defparameter *cam-gf-03-method3* |
---|
64 | (defmethod cam-gf-03 + ((x real)) 4)) |
---|
65 | |
---|
66 | (defparameter *cam-gf-03-method4* |
---|
67 | (defmethod cam-gf-03 + ((x number)) 8)) |
---|
68 | |
---|
69 | (defparameter *cam-gf-03-method5* |
---|
70 | (defmethod cam-gf-03 + ((x t)) 16)))) |
---|
71 | |
---|
72 | (deftest compute-applicable-methods.6 |
---|
73 | (equalt (compute-applicable-methods #'cam-gf-03 (list 0)) |
---|
74 | (list *cam-gf-03-method1* *cam-gf-03-method2* *cam-gf-03-method3* |
---|
75 | *cam-gf-03-method4* *cam-gf-03-method5*)) |
---|
76 | t) |
---|
77 | |
---|
78 | (eval-when (:load-toplevel :compile-toplevel :execute) |
---|
79 | (report-and-ignore-errors |
---|
80 | (defgeneric cam-gf-04 (x) |
---|
81 | (:method-combination + :most-specific-last)) |
---|
82 | |
---|
83 | (defparameter *cam-gf-04-method1* |
---|
84 | (defmethod cam-gf-04 + ((x integer)) 1)) |
---|
85 | |
---|
86 | (defparameter *cam-gf-04-method2* |
---|
87 | (defmethod cam-gf-04 + ((x rational)) 2)) |
---|
88 | |
---|
89 | (defparameter *cam-gf-04-method3* |
---|
90 | (defmethod cam-gf-04 + ((x real)) 4)) |
---|
91 | |
---|
92 | (defparameter *cam-gf-04-method4* |
---|
93 | (defmethod cam-gf-04 + ((x number)) 8)) |
---|
94 | |
---|
95 | (defparameter *cam-gf-04-method5* |
---|
96 | (defmethod cam-gf-04 + ((x t)) 16)) |
---|
97 | )) |
---|
98 | |
---|
99 | (deftest compute-applicable-methods.7 |
---|
100 | (equalt (compute-applicable-methods #'cam-gf-04 (list 0)) |
---|
101 | (list *cam-gf-04-method1* *cam-gf-04-method2* *cam-gf-04-method3* |
---|
102 | *cam-gf-04-method4* *cam-gf-04-method5*)) |
---|
103 | t) |
---|
104 | |
---|
105 | ;;; Need tests with :around, :before, :after methods |
---|
106 | |
---|
107 | ;;; Error tests |
---|
108 | |
---|
109 | (deftest compute-applicable-methods.error.1 |
---|
110 | (signals-error (compute-applicable-methods) |
---|
111 | program-error) |
---|
112 | t) |
---|
113 | |
---|
114 | (deftest compute-applicable-methods.error.2 |
---|
115 | (signals-error (compute-applicable-methods #'cam-gf-01) |
---|
116 | program-error) |
---|
117 | t) |
---|
118 | |
---|
119 | (deftest compute-applicable-methods.error.3 |
---|
120 | (signals-error (compute-applicable-methods #'cam-gf-01 '(1 2) nil) |
---|
121 | program-error) |
---|
122 | t) |
---|