source: trunk/source/tests/ansi-tests/find-method.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 3.6 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Tue Jun  3 21:12:03 2003
4;;;; Contains: Tests for FIND-METHOD
5
6(in-package :cl-test)
7
8(eval-when (:load-toplevel :compile-toplevel :execute)
9  (report-and-ignore-errors
10   (defgeneric find-method-gf-01 (x)))
11  (report-and-ignore-errors
12   (defparameter *find-method-gf-01-method1*
13     (defmethod find-method-gf-01 ((x integer)) 'a)))
14  (report-and-ignore-errors
15   (defparameter *find-method-gf-01-method2*
16     (defmethod find-method-gf-01 ((x rational)) 'b)))
17  (report-and-ignore-errors
18   (defparameter *find-method-gf-01-method3*
19     (defmethod find-method-gf-01 ((x real)) 'c)))
20  (report-and-ignore-errors
21   (defparameter *find-method-gf-01-method4*
22     (defmethod find-method-gf-01 ((x t)) 'd)))
23  )
24
25(deftest find-method.1
26  (eqt (find-method #'find-method-gf-01 nil (list (find-class 'integer)))
27       *find-method-gf-01-method1*)
28  t)
29
30(deftest find-method.2
31  (eqt (find-method #'find-method-gf-01 nil (list (find-class 'rational)))
32       *find-method-gf-01-method2*)
33  t)
34
35(deftest find-method.3
36  (eqt (find-method #'find-method-gf-01 nil (list (find-class 'real)))
37       *find-method-gf-01-method3*)
38  t)
39
40(deftest find-method.4
41  (eqt (find-method #'find-method-gf-01 nil (list (find-class t)))
42       *find-method-gf-01-method4*)
43  t)
44
45(deftest find-method.5
46  (find-method #'find-method-gf-01 (list :around) (list (find-class t))
47               nil)
48  nil)
49
50(deftest find-method.6
51  (find-method #'find-method-gf-01 (list :after)
52               (list (find-class 'integer)) nil)
53  nil)
54
55(deftest find-method.7
56  (find-method #'find-method-gf-01 (list :before) (list (find-class 'real))
57               nil)
58  nil)
59
60;;; EQL specializers
61
62(defgeneric find-method-gf-02 (x))
63
64(defparameter *find-method-gf-02-method1*
65  (defmethod find-method-gf-02 ((x (eql 1234567890))) 'a))
66
67(defparameter *find-method-02-method2-value* (list 'a))
68
69(defparameter *find-method-gf-02-method2*
70  (defmethod find-method-gf-02 ((x (eql *find-method-02-method2-value*)))
71    'b))
72
73(deftest find-method.8
74  (eqt (find-method #'find-method-gf-02 nil (list '(eql 1234567890)))
75       *find-method-gf-02-method1*)
76  t)
77
78(deftest find-method.9
79  (eqt (find-method #'find-method-gf-02 nil
80                    (list (list 'eql *find-method-02-method2-value*)))
81       *find-method-gf-02-method2*)
82  t)
83
84;;; Error tests
85
86(deftest find-method.error.1
87  (signals-error (find-method) program-error)
88  t)
89
90(deftest find-method.error.2
91  (signals-error (find-method #'find-method-gf-01) program-error)
92  t)
93
94(deftest find-method.error.3
95  (signals-error (find-method #'find-method-gf-01 nil) program-error)
96  t)
97
98(deftest find-method.error.4
99  (signals-error
100   (find-method #'find-method-gf-01 nil (list (find-class 'integer)) nil nil)
101   program-error)
102  t)
103
104(deftest find-method.error.5
105  (handler-case
106   (find-method #'find-method-gf-01 nil (list (find-class 'symbol)))
107   (error () :error))
108  :error)
109
110(deftest find-method.error.6
111  (handler-case
112   (find-method #'find-method-gf-01 nil (list (find-class 'symbol)) 'x)
113   (error () :error))
114  :error)
115
116(deftest find-method.error.7
117  (handler-case
118   (find-method #'find-method-gf-01 nil nil)
119   (error () :error))
120  :error)
121
122(deftest find-method.error.8
123  (handler-case
124   (find-method #'find-method-gf-01 nil (list (find-class 'integer)
125                                              (find-class t)))
126   (error () :error))
127  :error)
128
129(deftest find-method.error.9
130  (handler-case
131   (find-method #'find-method-gf-01 nil nil nil)
132   (error () :error))
133  :error)
134
135(deftest find-method.error.10
136  (handler-case
137   (find-method #'find-method-gf-01 nil (list (find-class 'integer)
138                                              (find-class t))
139                nil)
140   (error () :error))
141  :error)
142
143
144
145
146
147
148
149
150
Note: See TracBrowser for help on using the repository browser.