← Back to branch summary

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

« back to all changes in this revision

Viewing changes to ansi-tests/defgeneric-method-combination-and.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/defgeneric-method-combination-and.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Sat May 24 21:31:55 2003
 
4
;;;; Contains: Tests of DEFGENERIC with :method-combination AND
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
(declaim (special *x*))
 
9
 
 
10
(compile-and-load "defgeneric-method-combination-aux.lsp")
 
11
 
 
12
(deftest defgeneric-method-combination.and.1
 
13
  (let ((*x* nil)
 
14
        (fn
 
15
         (eval '(defgeneric dg-mc.fun.and.1 (x)
 
16
                  (:method-combination and)
 
17
                  (:method and ((x integer)) (push 4 *x*) t)
 
18
                  (:method and ((x rational)) (push 3 *x*) nil)
 
19
                  (:method and ((x number)) (push 2 *x*) t)
 
20
                  (:method and ((x t)) (push 1 *x*) 'a)))))
 
21
    (declare (type generic-function fn))
 
22
    (flet ((%f (y)
 
23
               (let ((*x* nil))
 
24
                 (list (funcall fn y) *x*))))
 
25
    (values (%f 1) (%f 2/3) (%f 1.54) (%f 'a))))
 
26
  (nil (3 4))
 
27
  (nil (3))
 
28
  (a (1 2))
 
29
  (a (1)))
 
30
 
 
31
(deftest defgeneric-method-combination.and.2
 
32
  (let ((*x* nil)
 
33
        (fn
 
34
         (eval '(defgeneric dg-mc.fun.and.2 (x)
 
35
                  (:method-combination and :most-specific-first)
 
36
                  (:method and ((x integer)) (push 4 *x*) t)
 
37
                  (:method and ((x rational)) (push 3 *x*) nil)
 
38
                  (:method and ((x number)) (push 2 *x*) t)
 
39
                  (:method and ((x t)) (push 1 *x*) 'a)))))
 
40
    (declare (type generic-function fn))
 
41
    (flet ((%f (y)
 
42
               (let ((*x* nil))
 
43
                 (list (funcall fn y) *x*))))
 
44
    (values (%f 1) (%f 2/3) (%f 1.54) (%f 'a))))
 
45
  (nil (3 4))
 
46
  (nil (3))
 
47
  (a (1 2))
 
48
  (a (1)))
 
49
 
 
50
(deftest defgeneric-method-combination.and.3
 
51
  (let ((*x* nil)
 
52
        (fn
 
53
         (eval '(defgeneric dg-mc.fun.and.3 (x)
 
54
                  (:method-combination and :most-specific-last)
 
55
                  (:method and ((x integer)) (push 4 *x*) t)
 
56
                  (:method and ((x rational)) (push 3 *x*) nil)
 
57
                  (:method and ((x number)) (push 2 *x*) 'a)
 
58
                  (:method and ((x t)) (push 1 *x*) t)))))
 
59
    (declare (type generic-function fn))
 
60
    (flet ((%f (y)
 
61
               (let ((*x* nil))
 
62
                 (list (funcall fn y) *x*))))
 
63
      (values (%f 1) (%f 2/3) (%f 1.54) (%f 'a))))
 
64
  (nil (3 2 1))
 
65
  (nil (3 2 1))
 
66
  (a (2 1))
 
67
  (t (1)))
 
68
 
 
69
(deftest defgeneric-method-combination.and.4
 
70
  (let ((fn
 
71
         (eval '(defgeneric dg-mc.and.4 (x)
 
72
                  (:method-combination and)
 
73
                  (:method and ((x integer)) t)
 
74
                  (:method :around ((x rational)) 'foo)
 
75
                  (:method and ((x number)) nil)
 
76
                  (:method and ((x symbol)) t)
 
77
                  (:method and ((x t)) 'a)))))
 
78
    (declare (type generic-function fn))
 
79
    (values
 
80
     (funcall fn 0)
 
81
     (funcall fn 4/3)
 
82
     (funcall fn 1.54)
 
83
     (funcall fn 'x)
 
84
     (funcall fn '(a b c))))
 
85
  foo foo nil a a)
 
86
 
 
87
(deftest defgeneric-method-combination.and.5
 
88
  (let ((fn
 
89
         (eval '(defgeneric dg-mc.and.5 (x)
 
90
                  (:method-combination and)
 
91
                  (:method and ((x integer)) nil)
 
92
                  (:method :around ((x rational))
 
93
                           (list 'foo (call-next-method)))
 
94
                  (:method and ((x number)) 'a)
 
95
                  (:method and ((x symbol)) 'b)
 
96
                  (:method and ((x t)) 'c)))))
 
97
    (declare (type generic-function fn))
 
98
    (values
 
99
     (funcall fn 0)
 
100
     (funcall fn 4/3)
 
101
     (funcall fn 1.54)
 
102
     (funcall fn 'x)
 
103
     (funcall fn '(a b c))))
 
104
  (foo nil) (foo c) c c c)
 
105
 
 
106
(deftest defgeneric-method-combination.and.6
 
107
  (let ((fn
 
108
         (eval '(defgeneric dg-mc.and.6 (x)
 
109
                  (:method-combination and)
 
110
                  (:method and ((x integer)) 'a)
 
111
                  (:method :around ((x rational))
 
112
                           (list 'foo (call-next-method)))
 
113
                  (:method :around ((x real))
 
114
                           (list 'bar (call-next-method)))
 
115
                  (:method and ((x number)) nil)
 
116
                  (:method and ((x symbol)) 'c)
 
117
                  (:method and ((x t)) 'd)))))
 
118
    (declare (type generic-function fn))
 
119
    (values
 
120
     (funcall fn 0)
 
121
     (funcall fn 4/3)
 
122
     (funcall fn 1.54)
 
123
     (funcall fn #c(1.0 2.0))
 
124
     (funcall fn 'x)
 
125
     (funcall fn '(a b c))))
 
126
  (foo (bar nil)) (foo (bar nil)) (bar nil) nil d d)
 
127
 
 
128
(deftest defgeneric-method-combination.and.7
 
129
  (let ((fn
 
130
         (eval '(defgeneric dg-mc.and.7 (x)
 
131
                  (:method-combination and)
 
132
                  (:method and ((x dgmc-class-04)) 'c)
 
133
                  (:method and ((x dgmc-class-03)) 'b)
 
134
                  (:method and ((x dgmc-class-02)) nil)
 
135
                  (:method and ((x dgmc-class-01)) 'a)))))
 
136
    (declare (type generic-function fn))
 
137
    (values
 
138
     (funcall fn (make-instance 'dgmc-class-01))
 
139
     (funcall fn (make-instance 'dgmc-class-02))
 
140
     (funcall fn (make-instance 'dgmc-class-03))
 
141
     (funcall fn (make-instance 'dgmc-class-04))))
 
142
  a nil a nil)
 
143
  
 
144
(deftest defgeneric-method-combination.and.8
 
145
  (let ((fn
 
146
         (eval '(defgeneric dg-mc.and.8 (x)
 
147
                  (:method-combination and)
 
148
                  (:method and ((x (eql 1000))) 'a)
 
149
                  (:method :around ((x symbol)) (values))
 
150
                  (:method :around ((x integer)) (values 'a 'b 'c))
 
151
                  (:method :around ((x complex)) (call-next-method))
 
152
                  (:method :around ((x number)) (values 1 2 3 4 5 6))
 
153
                  (:method and ((x t)) 'b)))))
 
154
    (declare (type generic-function fn))
 
155
    (values
 
156
     (multiple-value-list (funcall fn 'a))
 
157
     (multiple-value-list (funcall fn 10))
 
158
     (multiple-value-list (funcall fn #c(9 8)))
 
159
     (multiple-value-list (funcall fn '(a b c)))))
 
160
  () (a b c) (1 2 3 4 5 6) (b))
 
161
 
 
162
(deftest defgeneric-method-combination.and.9
 
163
  (handler-case
 
164
   (let ((fn (eval '(defgeneric dg-mc.and.9 (x)
 
165
                      (:method-combination and)))))
 
166
     (declare (type generic-function fn))
 
167
     (funcall fn 'x))
 
168
   (error () :error))
 
169
  :error)
 
170
 
 
171
(deftest defgeneric-method-combination.and.10
 
172
  (progn
 
173
    (eval '(defgeneric dg-mc.and.10 (x)
 
174
             (:method-combination and)
 
175
             (:method ((x t)) t)))    
 
176
    (handler-case
 
177
     (dg-mc.and.10 'a)
 
178
     (error () :error)))
 
179
  :error)
 
180
 
 
181
(deftest defgeneric-method-combination.and.11
 
182
  (progn
 
183
    (eval '(defgeneric dg-mc.and.11 (x)
 
184
             (:method-combination and)
 
185
             (:method nonsense ((x t)) t)))
 
186
    (handler-case
 
187
     (dg-mc.and.11 0)
 
188
     (error () :error)))
 
189
  :error)
 
190
 
 
191
(deftest defgeneric-method-combination.and.12
 
192
  (let ((fn (eval '(defgeneric dg-mc.and.12 (x)
 
193
                     (:method-combination and)
 
194
                     (:method :around ((x t)) t)
 
195
                     (:method and ((x integer)) x)))))
 
196
    (declare (type generic-function fn))
 
197
    (handler-case (funcall fn 'x)
 
198
                  (error () :error)))
 
199
  :error)