/[gcl]/gcl/ansi-tests/call-next-method.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/call-next-method.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by pfdietz, Sat May 31 17:48:59 2003 UTC revision 1.2 by pfdietz, Sun Jun 1 21:10:22 2003 UTC
# Line 7  Line 7 
7    
8  ;;; Tests where there is no next method are in no-next-method.lsp  ;;; Tests where there is no next method are in no-next-method.lsp
9    
10    (defgeneric cnm-gf-01 (x)
11      (:method ((x integer)) (cons 'a (call-next-method)))
12      (:method ((x rational)) (cons 'b (call-next-method)))
13      (:method ((x real)) (cons 'c (call-next-method)))
14      (:method ((x number)) (cons 'd (call-next-method)))
15      (:method ((x t)) nil))
16    
17    (deftest call-next-method.1
18      (mapcar #'cnm-gf-01 '(0 2/3 1.3 #c(1 1) a))
19      ((a b c d) (b c d) (c d) (d) nil))
20    
21    ;; Check that call-next-method passes along multiple values correctly
22    
23    (defgeneric cnm-gf-02 (x)
24      (:method ((x integer)) (call-next-method))
25      (:method ((x number)) (values))
26      (:method ((x (eql 'a))) (call-next-method))
27      (:method ((x symbol)) (values 1 2 3 4 5 6)))
28    
29    (deftest call-next-method.2
30      (cnm-gf-02 0))
31    
32    (deftest call-next-method.3
33      (cnm-gf-02 'a)
34      1 2 3 4 5 6)
35    
36    ;;; Call next method has indefinite extent
37    
38    (defgeneric cnm-gf-03 (x)
39      (:method ((x integer)) #'call-next-method)
40      (:method ((x t)) t))
41    
42    (deftest call-next-method.4
43      (funcall (cnm-gf-03 0))
44      t)
45    
46    ;;; The arguments to c-n-m can be changed
47    
48    (defgeneric cnm-gf-04 (x)
49      (:method ((x integer)) (call-next-method (+ x 10)))
50      (:method ((x number)) (1+ x)))
51    
52    (deftest call-next-method.5
53      (mapcar #'cnm-gf-04 '(0 1 2 5/3 9/2 1.0 #c(1 1)))
54      (11 12 13 8/3 11/2 2.0 #c(2 1)))
55    
56    
57    ;;; "When providing arguments to call-next-method, the following
58    ;;;  rule must be satisfied or an error of type error should be signaled:
59    ;;;  the ordered set of applicable methods for a changed set of arguments
60    ;;;  for call-next-method must be the same as the ordered set of applicable
61    ;;;  methods for the original arguments to the generic function."
62    
63    (defgeneric cnm-order-error-gf-01 (x)
64      (declare (optimize (safety 3)))
65      (:method ((x (eql 0)))
66               (declare (optimize (safety 3)))
67               (call-next-method 1))  ;; no longer EQL to 0
68      (:method ((x t)) nil))
69    
70    (deftest call-next-method.error.1
71      (locally
72       (declare (optimize (safety 3)))
73       (handler-case
74        (eval '(locally (declare (optimize (safety 3)))
75                        (cnm-order-error-gf-01 0)))
76        (error () :error)))
77      :error)
78    
79    (defgeneric cnm-order-error-gf-02 (x)
80      (declare (optimize (safety 3)))
81      (:method ((x integer))
82               (declare (optimize (safety 3)))
83               (call-next-method :bad))
84      (:method ((x t)) x))
85    
86    (deftest call-next-method.error.2
87      (locally
88       (declare (optimize (safety 3)))
89       (handler-case
90        (eval '(locally (declare (optimize (safety 3)))
91                        (cnm-order-error-gf-02 0)))
92        (error () :error)))
93      :error)
94    
95    
96    
97              
98    
99    
100      
101    

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26