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