source: trunk/source/tests/ansi-tests/warn.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.9 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Feb 23 20:48:12 2003
4;;;; Contains: Tests for WARN
5
6(in-package :cl-test)
7
8(deftest warn.1
9  (let ((warned nil))
10    (handler-bind
11     ((warning #'(lambda (c)
12                   (assert (typep c 'simple-warning))
13                   (setf warned t)
14                   (muffle-warning c))))
15     (values
16      (multiple-value-list (warn "This is a warning"))
17      warned)))
18  (nil) t)
19
20(deftest warn.2
21  (let ((warned nil))
22    (handler-bind
23     ((warning #'(lambda (c)
24                   (assert (typep c 'simple-warning))
25                   (setf warned t)
26                   (muffle-warning))))
27     (values
28      (multiple-value-list (warn "This is a warning"))
29      warned)))
30  (nil) t)
31
32(deftest warn.3
33  (with-output-to-string
34    (*error-output*)
35    (let ((warned nil))
36      (handler-bind
37       ((warning #'(lambda (c)
38                     (assert (typep c 'simple-warning))
39                     (setf warned t)
40                     (muffle-warning c))))
41       (warn "Foo!"))))
42  "")
43
44(deftest warn.4
45  (let ((str (with-output-to-string
46               (*error-output*)
47               (warn "Foo!"))))
48    (not (string= str "")))
49  t)
50
51(deftest warn.5
52  (let ((warned nil))
53    (handler-bind
54     ((simple-warning #'(lambda (c)
55                          (assert (typep c 'simple-warning))
56                          (setf warned t)
57                          (muffle-warning c))))
58     (values
59      (multiple-value-list (warn "This is a warning"))
60      warned)))
61  (nil) t)
62
63(deftest warn.6
64  (let ((warned nil))
65    (handler-bind
66     ((simple-condition #'(lambda (c)
67                            (assert (typep c 'simple-warning))
68                            (setf warned t)
69                            (muffle-warning c))))
70     (values
71      (multiple-value-list (warn "This is a warning"))
72      warned)))
73  (nil) t)
74
75(deftest warn.7
76  (let ((warned nil))
77    (handler-bind
78     ((condition #'(lambda (c)
79                     (assert (typep c 'simple-warning))
80                     (setf warned t)
81                     (muffle-warning c))))
82     (values
83      (multiple-value-list (warn "This is a warning"))
84      warned)))
85  (nil) t)
86
87(deftest warn.8
88  (let ((warned nil))
89    (handler-bind
90     ((warning #'(lambda (c)
91                   (assert (typep c 'simple-warning))
92                   (setf warned t)
93                   (muffle-warning c))))
94     (values
95      (multiple-value-list (warn 'simple-warning :format-control "Foo!"))
96      warned)))
97  (nil) t)
98
99(deftest warn.9
100  (let ((warned nil))
101    (handler-bind
102     ((warning #'(lambda (c)
103                   (assert (typep c 'warning))
104                   (setf warned t)
105                   (muffle-warning c))))
106     (values
107      (multiple-value-list (warn 'warning))
108      warned)))
109  (nil) t)
110
111(deftest warn.10
112  (let ((warned nil))
113    (handler-bind
114     ((warning #'(lambda (c)
115                   (assert (typep c 'simple-warning))
116                   (setf warned t)
117                   (muffle-warning c))))
118     (values
119      (multiple-value-list (warn (make-condition 'simple-warning :format-control "Foo!")))
120      warned)))
121  (nil) t)
122
123(deftest warn.11
124  (let ((warned nil))
125    (handler-bind
126     ((warning #'(lambda (c)
127                   (assert (typep c 'warning))
128                   (setf warned t)
129                   (muffle-warning c))))
130     (values
131      (multiple-value-list (warn (make-condition 'warning)))
132      warned)))
133  (nil) t)
134
135(deftest warn.12
136  (signals-error (warn 'condition) type-error)
137  t)
138
139(deftest warn.13
140  (signals-error (warn 'simple-condition) type-error)
141  t)
142
143(deftest warn.14
144  (signals-error (warn (make-condition 'simple-warning) :format-control "Foo") type-error)
145  t)
146
147(deftest warn.15
148  (signals-error (warn) program-error)
149  t)
150
151(deftest warn.16
152  (signals-error (warn (make-condition 'condition)) type-error)
153  t)
154
155(deftest warn.17
156  (signals-error (warn (make-condition 'simple-condition)) type-error)
157  t)
158
159(deftest warn.18
160  (signals-error (warn (make-condition 'simple-error)) type-error)
161  t)
162
163(deftest warn.19
164  (let ((warned nil))
165    (handler-bind
166     ((warning #'(lambda (c)
167                   (assert (typep c 'simple-warning))
168                   (setf warned t)
169                   (muffle-warning c))))
170     (values
171      (multiple-value-list
172       (warn (make-condition 'simple-warning
173                             :format-control (formatter "Foo!"))))
174      warned)))
175  (nil) t)
Note: See TracBrowser for help on using the repository browser.