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