source: trunk/j/src/org/armedbear/lisp/tests/condition-tests.lisp @ 10331

Last change on this file since 10331 was 10331, checked in by piso, 16 years ago

Work in progress.

File size: 7.1 KB
Line 
1;;; condition-tests.lisp
2;;;
3;;; Copyright (C) 2005 Peter Graves
4;;;
5;;; This program is free software; you can redistribute it and/or
6;;; modify it under the terms of the GNU General Public License
7;;; as published by the Free Software Foundation; either version 2
8;;; of the License, or (at your option) any later version.
9;;;
10;;; This program is distributed in the hope that it will be useful,
11;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13;;; GNU General Public License for more details.
14;;;
15;;; You should have received a copy of the GNU General Public License
16;;; along with this program; if not, write to the Free Software
17;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
18
19(load (merge-pathnames "test-utilities.lisp" *load-truename*))
20
21(in-package #:test)
22
23(deftest print-not-readable-object.1
24  (signals-error (slot-boundp (make-condition 'print-not-readable)
25                              #+abcl    'system::object
26                              #+allegro 'excl::object
27                              #+clisp   'system::$object
28                              #+cmu     'lisp::object
29                              #+sbcl    'sb-kernel::object)
30                 'error)
31  nil)
32
33(deftest print-not-readable-object.2
34  (slot-boundp (make-condition 'print-not-readable)
35               #+abcl    'system::object
36               #+allegro 'excl::object
37               #+clisp   'system::$object
38               #+cmu     'lisp::object
39               #+sbcl    'sb-kernel::object)
40  nil)
41
42(deftest type-error.1
43  (type-error-datum (make-instance 'type-error :datum 42))
44  42)
45
46(deftest type-error.2
47  (type-error-expected-type (make-instance 'type-error :expected-type 'symbol))
48  symbol)
49
50#+(or abcl clisp cmu sbcl)
51(deftest type-error.3
52  (write-to-string (make-condition 'type-error :datum 42 :expected-type 'symbol)
53                   :escape nil)
54  #+clisp
55  "Condition of type TYPE-ERROR."
56  #+cmu
57  "Type-error in NIL:  42 is not of type SYMBOL"
58  #+(or abcl sbcl)
59  "The value 42 is not of type SYMBOL.")
60
61#+(or abcl clisp cmu sbcl)
62(deftest type-error.4
63  (format nil "~A" (make-condition 'type-error :datum 42 :expected-type 'symbol))
64  #+clisp
65  "Condition of type TYPE-ERROR."
66  #+cmu
67  "Type-error in NIL:  42 is not of type SYMBOL"
68  #+(or abcl sbcl)
69  "The value 42 is not of type SYMBOL.")
70
71(deftest simple-type-error.1
72  (slot-boundp (make-condition 'simple-type-error)
73               #+abcl    'system::datum
74               #+allegro 'excl::datum
75               #+clisp   'system::$datum
76               #+cmu     'conditions::datum
77               #+sbcl    'sb-kernel::datum)
78  nil)
79
80(deftest simple-type-error.2
81  (slot-boundp (make-condition 'simple-type-error)
82               #+abcl    'system::expected-type
83               #+allegro 'excl::expected-type
84               #+clisp   'system::$expected-type
85               #+cmu     'conditions::expected-type
86               #+sbcl    'sb-kernel::expected-type)
87  nil)
88
89(deftest simple-type-error.3
90  (slot-boundp (make-condition 'simple-type-error)
91               #+abcl    'system::format-control
92               #+allegro 'excl::format-control
93               #+clisp   'system::$format-control
94               #+cmu     'conditions::format-control
95               #+sbcl    'sb-kernel:format-control)
96  #-clisp nil
97  #+clisp t)
98
99#+clisp
100(deftest simple-type-error.3a
101  (simple-condition-format-control (make-condition 'simple-type-error))
102  nil)
103
104(deftest simple-type-error.4
105  (slot-boundp (make-condition 'simple-type-error)
106               #+abcl    'system::format-arguments
107               #+allegro 'excl::format-arguments
108               #+clisp   'system::$format-arguments
109               #+cmu     'conditions::format-arguments
110               #+sbcl    'sb-kernel::format-arguments)
111  t)
112
113(deftest simple-type-error.5
114  (slot-value (make-condition 'simple-type-error)
115              #+abcl    'system::format-arguments
116              #+allegro 'excl::format-arguments
117              #+clisp   'system::$format-arguments
118              #+cmu     'conditions::format-arguments
119              #+sbcl    'sb-kernel::format-arguments)
120  nil)
121
122(deftest simple-type-error.6
123  (slot-boundp (make-instance 'simple-type-error)
124               #+abcl    'system::datum
125               #+allegro 'excl::datum
126               #+clisp   'system::$datum
127               #+cmu     'conditions::datum
128               #+sbcl    'sb-kernel::datum)
129  nil)
130
131(deftest simple-type-error.7
132  (slot-boundp (make-instance 'simple-type-error)
133               #+abcl    'system::expected-type
134               #+allegro 'excl::expected-type
135               #+clisp   'system::$expected-type
136               #+cmu     'conditions::expected-type
137               #+sbcl    'sb-kernel::expected-type)
138  nil)
139
140(deftest simple-type-error.8
141  (slot-boundp (make-instance 'simple-type-error)
142               #+abcl    'system::format-control
143               #+allegro 'excl::format-control
144               #+clisp   'system::$format-control
145               #+cmu     'conditions::format-control
146               #+sbcl    'sb-kernel:format-control)
147  #-clisp nil
148  #+clisp t)
149
150#+clisp
151(deftest simple-type-error.8a
152  (simple-condition-format-control (make-instance 'simple-type-error))
153  nil)
154
155(deftest simple-type-error.9
156  (slot-boundp (make-instance 'simple-type-error)
157               #+abcl    'system::format-arguments
158               #+allegro 'excl::format-arguments
159               #+clisp   'system::$format-arguments
160               #+cmu     'conditions::format-arguments
161               #+sbcl    'sb-kernel::format-arguments)
162  t)
163
164(deftest simple-type-error.10
165  (slot-value (make-instance 'simple-type-error)
166              #+abcl    'system::format-arguments
167              #+allegro 'excl::format-arguments
168              #+clisp   'system::$format-arguments
169              #+cmu     'conditions::format-arguments
170              #+sbcl    'sb-kernel::format-arguments)
171  nil)
172
173(deftest define-condition.1
174  (progn
175    (setf (find-class 'test-error) nil)
176    (define-condition test-error (type-error) ())
177    (type-error-datum (make-condition 'test-error :datum 42 :expected-type 'symbol)))
178  42)
179
180(deftest define-condition.2
181  (progn
182    (setf (find-class 'test-error) nil)
183    (define-condition test-error (type-error) ())
184    (type-error-expected-type (make-condition 'test-error :datum 42 :expected-type 'symbol)))
185  symbol)
186
187#+(or abcl clisp cmu sbcl)
188(deftest define-condition.3
189  (progn
190    (setf (find-class 'test-error) nil)
191    (define-condition test-error (type-error) ())
192    (format nil "~A" (make-condition 'test-error :datum 42 :expected-type 'symbol)))
193  #+clisp
194  "Condition of type TEST-ERROR."
195  #+cmu
196  "Type-error in NIL:  42 is not of type SYMBOL"
197  #+(or abcl sbcl)
198  "The value 42 is not of type SYMBOL.")
199
200#+(or abcl clisp cmu sbcl)
201(deftest define-condition.4
202  (progn
203    (setf (find-class 'test-error) nil)
204    (define-condition test-error (type-error) ())
205    (write-to-string (make-condition 'test-error :datum 42 :expected-type 'symbol)
206                     :escape nil))
207  #+clisp
208  "Condition of type TEST-ERROR."
209  #+cmu
210  "Type-error in NIL:  42 is not of type SYMBOL"
211  #+(or abcl sbcl)
212  "The value 42 is not of type SYMBOL.")
213
214(do-tests)
Note: See TracBrowser for help on using the repository browser.