source: trunk/source/tests/ansi-tests/define-method-combination.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: 5.0 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Jun 15 10:49:39 2003
4;;;; Contains: Tests of DEFINE-METHOD-COMBINATION
5
6(in-package :cl-test)
7
8(defclass dmc-class-01a () ())
9(defclass dmc-class-01b (dmc-class-01a) ())
10(defclass dmc-class-01c (dmc-class-01a) ())
11(defclass dmc-class-01d (dmc-class-01b dmc-class-01c) ())
12(defclass dmc-class-01e (dmc-class-01c dmc-class-01b) ())
13(defclass dmc-class-01f (dmc-class-01d) ())
14(defclass dmc-class-01g (dmc-class-01a) ())
15(defclass dmc-class-01h (dmc-class-01f dmc-class-01g) ())
16
17(eval-when (:load-toplevel :compile-toplevel :execute)
18  (report-and-ignore-errors
19   (defvar *dmc-times*
20     (define-method-combination times
21       :documentation "Multiplicative method combination, version 1"
22       :operator *))
23   
24   (defgeneric dmc-gf-01 (x) (:method-combination times))
25   
26   (defmethod dmc-gf-01 times ((x integer)) 2)
27   (defmethod dmc-gf-01 times ((x rational)) 3)
28   (defmethod dmc-gf-01 times ((x real)) 5)
29   (defmethod dmc-gf-01 times ((x number)) 7)
30   (defmethod dmc-gf-01 times ((x complex)) 11)
31   ))
32
33(deftest define-method-combination-01.1
34  (values
35   (dmc-gf-01 1)
36   (dmc-gf-01 1/2)
37   (dmc-gf-01 1.0)
38   (dmc-gf-01 #c(1 2)))
39  210 105 35 77)
40
41(deftest define-method-combination-01.2
42  (handler-case
43   (eval '(locally (declare (optimize (safety 3)))
44                   (dmc-gf-01 'x)))
45   (error () :good))
46  :good)
47
48(deftest define-method-combination-01.3
49  *dmc-times*
50  times)
51
52(deftest define-method-combination-01.4
53  (let ((doc (documentation *dmc-times* 'method-combination)))
54    (or (null doc)
55        (equalt doc "Multiplicative method combination, version 1")))
56  t)           
57
58(eval-when (:load-toplevel :compile-toplevel :execute)
59  (report-and-ignore-errors
60   (defgeneric dmc-gf-02 (x) (:method-combination times))
61   
62   (defmethod dmc-gf-02 times ((x integer)) 2)
63   (defmethod dmc-gf-02 :around ((x rational)) (1- (call-next-method)))
64   (defmethod dmc-gf-02 times ((x real)) 3)
65   (defmethod dmc-gf-02 times ((x number)) 5)
66   (defmethod dmc-gf-02 :around ((x (eql 1.0s0))) 1)
67   ))
68
69(deftest define-method-combination-02.1
70  (values
71   (dmc-gf-02 1)
72   (dmc-gf-02 1/3)
73   (dmc-gf-02 1.0s0)
74   (dmc-gf-02 13.0)
75   (dmc-gf-02 #c(1 2)))
76  29 14 1 15 5)
77
78(eval-when (:load-toplevel :compile-toplevel :execute)
79  (report-and-ignore-errors
80   (defgeneric dmc-gf-03 (x) (:method-combination times))))
81
82(deftest define-method-combination-03.1
83  (prog1
84      (handler-case
85       (progn
86         (eval '(defmethod dmc-gf-03 ((x integer)) t))
87         (eval '(dmc-gf-03 1))
88         :bad)
89       (error () :good))
90    (dolist (meth (compute-applicable-methods #'dmc-gf-03 (list 1)))
91      (remove-method #'dmc-gf-03 meth)))
92  :good)
93
94(deftest define-method-combination-03.2
95  (prog1
96      (handler-case
97       (progn
98         (eval '(defmethod dmc-gf-03 :before ((x cons)) t))
99         (eval '(dmc-gf-03 (cons 'a 'b)))
100         :bad)
101       (error () :good))
102    (dolist (meth (compute-applicable-methods #'dmc-gf-03 (list '(a))))
103      (remove-method #'dmc-gf-03 meth)))
104  :good)
105
106(deftest define-method-combination-03.3
107  (prog1
108      (handler-case
109       (progn
110         (eval '(defmethod dmc-gf-03 :after ((x symbol)) t))
111         (eval '(dmc-gf-03 'a))
112         :bad)
113       (error () :good))
114    (dolist (meth (compute-applicable-methods #'dmc-gf-03 (list 'a)))
115      (remove-method #'dmc-gf-03 meth)))
116  :good)
117
118(eval-when (:load-toplevel :compile-toplevel :execute)
119  (report-and-ignore-errors
120   (define-method-combination times2
121     :operator *
122     :identity-with-one-argument t)
123   
124   (defgeneric dmc-gf-04 (x) (:method-combination times2))
125   
126   (defmethod dmc-gf-04 times2 ((x dmc-class-01b)) 2)
127   (defmethod dmc-gf-04 times2 ((x dmc-class-01c)) 3)
128   (defmethod dmc-gf-04 times2 ((x dmc-class-01d)) 5)
129   (defmethod dmc-gf-04 times2 ((x symbol)) nil)
130   ))
131
132(deftest define-method-combination-04.1
133  (dmc-gf-04 (make-instance 'dmc-class-01h))
134  30)
135
136(deftest define-method-combination-04.2
137  (dmc-gf-04 (make-instance 'dmc-class-01e))
138  6)
139
140(deftest define-method-combination-04.3
141  (dmc-gf-04 'a)
142  nil)
143
144(eval-when (:load-toplevel :compile-toplevel :execute)
145  (report-and-ignore-errors
146   (defvar *dmc-times-5*
147     (define-method-combination times-5 :operator *))))
148
149(deftest define-method-combination-05.1
150  (let* ((doc1 (setf (documentation *dmc-times-5* 'method-combination)
151                     "foo"))
152         (doc2 (documentation *dmc-times-5* 'method-combination)))
153    (values
154     doc1
155     (or (null doc2)
156         (equalt doc2 "foo"))))
157  "foo" t)
158
159;; Operator name defaults to the method combination name.
160
161(eval-when (:load-toplevel :compile-toplevel :execute)
162  (defun times-7 (&rest args) (apply #'* args))
163  (report-and-ignore-errors
164   (defvar *dmc-times-7*
165     (define-method-combination times-7))
166   (defgeneric dmc-gf-07 (x) (:method-combination times))
167
168   (defmethod dmc-gf-07 times ((x integer)) 2)
169   (defmethod dmc-gf-07 times ((x rational)) 3)
170   (defmethod dmc-gf-07 times ((x real)) 5)
171   (defmethod dmc-gf-07 times ((x number)) 7)
172   (defmethod dmc-gf-07 times ((x complex)) 11)
173   ))
174
175(deftest define-method-combination-07.1
176  (values
177   (dmc-gf-07 1)
178   (dmc-gf-07 1/2)
179   (dmc-gf-07 1.0)
180   (dmc-gf-07 #c(1 2)))
181  210 105 35 77)
Note: See TracBrowser for help on using the repository browser.