← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/define-method-combination.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/define-method-combination.lsp
 
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)