source: trunk/abcl/test/lisp/abcl/condition-tests.lisp

Last change on this file was 12402, checked in by Mark Evenson, 14 years ago

Move abcl-test-lisp to ASDF packaging.

Change to ASDF packaging of abcl-test-lisp. Remove ASDF system
'abcl-tests' as ASDF systems without components don't carry
dependencies transitively. Remove unneed :BEFORE load of
abcl-test-lisp. Renamed conflicting tests now that they are loaded via
ASDF.

Implement ability to run tests matching a string. Export
ABCL.TEST.LISP::RUN-MATCHING as external symbol.

Added 'test/lisp/abcl/math-tests.lisp' back to ABCL.TEST.LISP, fixing
errors that prevented it from working.

Fix bug with directories specified to three-arg form of SYS:ZIP. JAR
files always use '/' to name hierarchial entries. Allow of a top
directory for creating hierarchially ZIPs: for arguments like
"pathname pathnames &optional topdir" all pathnames will be
interpolated relative to topdir.

Contains the version of jar-file tests corresponding to PATHNAME,
TRUENAME, and PROBE-FILE. The tests for jar-file will currently fail
as it needs the implementation of SYS:UNZIP which in turn depends on
the new version of Pathname which should follow shortly in a separate
commit.

jar-file initilization rewritten in Lisp, so it works under Windows.

Java tests for Pathname and Stream.

Help my dyslexic brain by renaming
*abcl-{lisp-test,test,lisp}-directory* to *abcl-test-directory*.

Refinement of jar-file tests. Correct all JAR-FILE.PATHNAME.* tests.
JAR-FILE tests use the cross-platform form of COPY-FILE. Renamed test,
using WITH-JAR-FILE-INIT macro.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 10.0 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(in-package #:abcl.test.lisp)
20
21(defun filter (string)
22  "If STRING is unreadable, return \"#<>\"; otherwise return STRING unchanged."
23  (let ((len (length string)))
24    (when (> len 3)
25      (when (string= (subseq string 0 2) "#<")
26        (when (char= (char string (1- len)) #\>)
27          (setf string "#<>")))))
28  string)
29
30(deftest condition.1
31  (filter (write-to-string (make-condition 'condition) :escape t))
32  "#<>")
33
34(deftest condition.2
35  (filter (write-to-string (make-condition 'condition) :escape nil))
36  #+(or abcl allegro)
37  "#<>"
38  #+clisp
39  "Condition of type CONDITION."
40  #+(or cmu sbcl)
41  "Condition CONDITION was signalled.")
42
43#+(or abcl allegro)
44(deftest condition.3
45  (write-to-string (make-condition 'condition
46                                   :format-control "The bear is armed.")
47                   :escape nil)
48  "The bear is armed.")
49
50(deftest print-not-readable-object.1
51  (signals-error (slot-boundp (make-condition 'print-not-readable)
52                              #+abcl    'system::object
53                              #+allegro 'excl::object
54                              #+clisp   'system::$object
55                              #+cmu     'lisp::object
56                              #+sbcl    'sb-kernel::object)
57                 'error)
58  nil)
59
60(deftest print-not-readable-object.2
61  (slot-boundp (make-condition 'print-not-readable)
62               #+abcl    'system::object
63               #+allegro 'excl::object
64               #+clisp   'system::$object
65               #+cmu     'lisp::object
66               #+sbcl    'sb-kernel::object)
67  nil)
68
69(deftest type-error.1
70  (type-error-datum (make-instance 'type-error :datum 42))
71  42)
72
73(deftest type-error.2
74  (type-error-expected-type (make-instance 'type-error :expected-type 'symbol))
75  symbol)
76
77(deftest type-error.3
78  (let ((c (make-condition 'type-error :datum 42 :expected-type 'symbol)))
79    (filter (write-to-string c :escape nil)))
80  #+allegro
81  "#<>"
82  #+clisp
83  "Condition of type TYPE-ERROR."
84  #+cmu
85  "Type-error in NIL:  42 is not of type SYMBOL"
86  #+(or abcl sbcl)
87  "The value 42 is not of type SYMBOL.")
88
89(deftest type-error.4
90  (let ((c (make-condition 'type-error :datum 42 :expected-type 'symbol)))
91    (filter (format nil "~A" c)))
92  #+allegro
93  "#<>"
94  #+clisp
95  "Condition of type TYPE-ERROR."
96  #+cmu
97  "Type-error in NIL:  42 is not of type SYMBOL"
98  #+(or abcl sbcl)
99  "The value 42 is not of type SYMBOL.")
100
101(deftest simple-type-error.1
102  (slot-boundp (make-condition 'simple-type-error)
103               #+abcl    'system::datum
104               #+allegro 'excl::datum
105               #+clisp   'system::$datum
106               #+cmu     'conditions::datum
107               #+sbcl    'sb-kernel::datum)
108  nil)
109
110(deftest simple-type-error.2
111  (slot-boundp (make-condition 'simple-type-error)
112               #+abcl    'system::expected-type
113               #+allegro 'excl::expected-type
114               #+clisp   'system::$expected-type
115               #+cmu     'conditions::expected-type
116               #+sbcl    'sb-kernel::expected-type)
117  nil)
118
119(deftest simple-type-error.3
120  (slot-boundp (make-condition 'simple-type-error)
121               #+abcl    'system::format-control
122               #+allegro 'excl::format-control
123               #+clisp   'system::$format-control
124               #+cmu     'conditions::format-control
125               #+sbcl    'sb-kernel:format-control)
126  #-clisp nil
127  #+clisp t)
128
129#+clisp
130(deftest simple-type-error.3a
131  (simple-condition-format-control (make-condition 'simple-type-error))
132  nil)
133
134(deftest simple-type-error.4
135  (slot-boundp (make-condition 'simple-type-error)
136               #+abcl    'system::format-arguments
137               #+allegro 'excl::format-arguments
138               #+clisp   'system::$format-arguments
139               #+cmu     'conditions::format-arguments
140               #+sbcl    'sb-kernel::format-arguments)
141  t)
142
143(deftest simple-type-error.5
144  (slot-value (make-condition 'simple-type-error)
145              #+abcl    'system::format-arguments
146              #+allegro 'excl::format-arguments
147              #+clisp   'system::$format-arguments
148              #+cmu     'conditions::format-arguments
149              #+sbcl    'sb-kernel::format-arguments)
150  nil)
151
152(deftest simple-type-error.6
153  (slot-boundp (make-instance 'simple-type-error)
154               #+abcl    'system::datum
155               #+allegro 'excl::datum
156               #+clisp   'system::$datum
157               #+cmu     'conditions::datum
158               #+sbcl    'sb-kernel::datum)
159  nil)
160
161(deftest simple-type-error.7
162  (slot-boundp (make-instance 'simple-type-error)
163               #+abcl    'system::expected-type
164               #+allegro 'excl::expected-type
165               #+clisp   'system::$expected-type
166               #+cmu     'conditions::expected-type
167               #+sbcl    'sb-kernel::expected-type)
168  nil)
169
170(deftest simple-type-error.8
171  (slot-boundp (make-instance 'simple-type-error)
172               #+abcl    'system::format-control
173               #+allegro 'excl::format-control
174               #+clisp   'system::$format-control
175               #+cmu     'conditions::format-control
176               #+sbcl    'sb-kernel:format-control)
177  #-clisp nil
178  #+clisp t)
179
180#+clisp
181(deftest simple-type-error.8a
182  (simple-condition-format-control (make-instance 'simple-type-error))
183  nil)
184
185(deftest simple-type-error.9
186  (slot-boundp (make-instance 'simple-type-error)
187               #+abcl    'system::format-arguments
188               #+allegro 'excl::format-arguments
189               #+clisp   'system::$format-arguments
190               #+cmu     'conditions::format-arguments
191               #+sbcl    'sb-kernel::format-arguments)
192  t)
193
194(deftest simple-type-error.10
195  (slot-value (make-instance 'simple-type-error)
196              #+abcl    'system::format-arguments
197              #+allegro 'excl::format-arguments
198              #+clisp   'system::$format-arguments
199              #+cmu     'conditions::format-arguments
200              #+sbcl    'sb-kernel::format-arguments)
201  nil)
202
203(deftest define-condition.1
204  (progn
205    (setf (find-class 'test-error) nil)
206    (define-condition test-error (type-error) ())
207    (type-error-datum (make-condition 'test-error :datum 42 :expected-type 'symbol)))
208  42)
209
210(deftest define-condition.2
211  (progn
212    (setf (find-class 'test-error) nil)
213    (define-condition test-error (type-error) ())
214    (type-error-expected-type (make-condition 'test-error :datum 42 :expected-type 'symbol)))
215  symbol)
216
217#+(or abcl allegro)
218(deftest define-condition.3
219  (progn
220    (setf (find-class 'test-error) nil)
221    (define-condition test-error (type-error) ())
222    (slot-boundp (make-condition 'test-error)
223                 #+abcl    'system::format-control
224                 #+allegro 'excl::format-control))
225  nil)
226
227#+(or abcl allegro)
228(deftest define-condition.4
229  (progn
230    (setf (find-class 'test-error) nil)
231    (define-condition test-error (type-error) ())
232    (simple-condition-format-arguments (make-condition 'test-error)))
233  nil)
234
235(deftest define-condition.5
236  (progn
237    (setf (find-class 'test-error) nil)
238    (define-condition test-error (type-error) ())
239    (let ((c (make-condition 'test-error :datum 42 :expected-type 'symbol)))
240      (filter (format nil "~A" c))))
241  #+allegro
242  "#<>"
243  #+clisp
244  "Condition of type TEST-ERROR."
245  #+cmu
246  "Type-error in NIL:  42 is not of type SYMBOL"
247  #+(or abcl sbcl)
248  "The value 42 is not of type SYMBOL.")
249
250#+(or abcl clisp cmu sbcl)
251(deftest define-condition.6
252  (progn
253    (setf (find-class 'test-error) nil)
254    (define-condition test-error (type-error) ())
255    (let ((c (make-condition 'test-error :datum 42 :expected-type 'symbol)))
256      (filter (write-to-string c :escape nil))))
257  #+allegro
258  "#<>"
259  #+clisp
260  "Condition of type TEST-ERROR."
261  #+cmu
262  "Type-error in NIL:  42 is not of type SYMBOL"
263  #+(or abcl sbcl)
264  "The value 42 is not of type SYMBOL.")
265
266#+(or abcl allegro)
267(deftest define-condition.7
268  (progn
269    (setf (find-class 'test-error) nil)
270    (define-condition test-error (type-error) ())
271    (let ((c (make-condition 'test-error
272                             :datum 42
273                             :expected-type 'symbol
274                             :format-control "The bear is armed.")))
275      (write-to-string c :escape nil)))
276  "The bear is armed.")
277
278#+(or abcl allegro)
279(deftest define-condition.8
280  (progn
281    (setf (find-class 'test-error) nil)
282    (define-condition test-error (type-error) ())
283    (let ((c (make-condition 'test-error
284                             :datum 42
285                             :expected-type 'symbol
286                             :format-control "~A is ~A."
287                             :format-arguments (list "The bear" "armed"))))
288      (write-to-string c :escape nil)))
289  "The bear is armed.")
290
291#+(or abcl allegro)
292(deftest define-condition.9
293  (progn
294    (setf (find-class 'test-error) nil)
295    (define-condition test-error (condition) ())
296    (let ((c (make-condition 'test-error
297                             :format-control "The bear is armed.")))
298      (write-to-string c :escape nil)))
299  "The bear is armed.")
300
301#+(or abcl allegro)
302(deftest define-condition.10
303  (progn
304    (setf (find-class 'test-error) nil)
305    (define-condition test-error (condition) ())
306    (let ((c (make-condition 'test-error
307                             :format-control "~A is ~A."
308                             :format-arguments (list "The bear" "armed"))))
309      (write-to-string c :escape nil)))
310  "The bear is armed.")
Note: See TracBrowser for help on using the repository browser.