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

Last change on this file since 10316 was 10316, checked in by piso, 16 years ago
  • TYPE-ERROR.1, TYPE-ERROR.2
  • Conditionalize SIMPLE-TYPE-ERROR tests for CLISP.
File size: 4.7 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                              #+sbcl    'sb-kernel::object)
29                 'error)
30  nil)
31
32(deftest print-not-readable-object.2
33  (slot-boundp (make-condition 'print-not-readable)
34               #+abcl    'system::object
35               #+allegro 'excl::object
36               #+clisp   'system::$object
37               #+sbcl    'sb-kernel::object)
38  nil)
39
40(deftest type-error.1
41  (type-error-datum (make-instance 'type-error :datum 42))
42  42)
43
44(deftest type-error.2
45  (type-error-expected-type (make-instance 'type-error :expected-type 'symbol))
46  symbol)
47
48(deftest simple-type-error.1
49  (slot-boundp (make-condition 'simple-type-error)
50               #+abcl    'system::datum
51               #+allegro 'excl::datum
52               #+clisp   'system::$datum
53               #+sbcl    'sb-kernel::datum)
54  nil)
55
56(deftest simple-type-error.2
57  (slot-boundp (make-condition 'simple-type-error)
58               #+abcl    'system::expected-type
59               #+allegro 'excl::expected-type
60               #+clisp   'system::$expected-type
61               #+sbcl    'sb-kernel::expected-type)
62  nil)
63
64(deftest simple-type-error.3
65  (slot-boundp (make-condition 'simple-type-error)
66               #+abcl    'system::format-control
67               #+allegro 'excl::format-control
68               #+clisp   'system::$format-control
69               #+sbcl    'sb-kernel:format-control)
70  #-clisp nil
71  #+clisp t)
72
73#+clisp
74(deftest simple-type-error.3a
75  (simple-condition-format-control (make-condition 'simple-type-error))
76  nil)
77
78(deftest simple-type-error.4
79  (slot-boundp (make-condition 'simple-type-error)
80               #+abcl    'system::format-arguments
81               #+allegro 'excl::format-arguments
82               #+clisp   'system::$format-arguments
83               #+sbcl    'sb-kernel::format-arguments)
84  t)
85
86(deftest simple-type-error.5
87  (slot-value (make-condition 'simple-type-error)
88              #+abcl    'system::format-arguments
89              #+allegro 'excl::format-arguments
90              #+clisp   'system::$format-arguments
91              #+sbcl    'sb-kernel::format-arguments)
92  nil)
93
94(deftest simple-type-error.6
95  (slot-boundp (make-instance 'simple-type-error)
96               #+abcl    'system::datum
97               #+allegro 'excl::datum
98               #+clisp   'system::$datum
99               #+sbcl    'sb-kernel::datum)
100  nil)
101
102(deftest simple-type-error.7
103  (slot-boundp (make-instance 'simple-type-error)
104               #+abcl    'system::expected-type
105               #+allegro 'excl::expected-type
106               #+clisp   'system::$expected-type
107               #+sbcl    'sb-kernel::expected-type)
108  nil)
109
110(deftest simple-type-error.8
111  (slot-boundp (make-instance 'simple-type-error)
112               #+abcl    'system::format-control
113               #+allegro 'excl::format-control
114               #+clisp   'system::$format-control
115               #+sbcl    'sb-kernel:format-control)
116  #-clisp nil
117  #+clisp t)
118
119#+clisp
120(deftest simple-type-error.8a
121  (simple-condition-format-control (make-instance 'simple-type-error))
122  nil)
123
124(deftest simple-type-error.9
125  (slot-boundp (make-instance 'simple-type-error)
126               #+abcl    'system::format-arguments
127               #+allegro 'excl::format-arguments
128               #+clisp   'system::$format-arguments
129               #+sbcl    'sb-kernel::format-arguments)
130  t)
131
132(deftest simple-type-error.10
133  (slot-value (make-instance 'simple-type-error)
134              #+abcl    'system::format-arguments
135              #+allegro 'excl::format-arguments
136              #+clisp   'system::$format-arguments
137              #+sbcl    'sb-kernel::format-arguments)
138  nil)
139
140(do-tests)
Note: See TracBrowser for help on using the repository browser.