source: trunk/source/tests/ansi-tests/compute-applicable-methods.lsp @ 8991

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

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

File size: 3.4 KB
Line 
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)
Note: See TracBrowser for help on using the repository browser.