← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/handler-case.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/handler-case.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Sat Mar  1 14:08:07 2003
 
4
;;;; Contains: Tests of HANDLER-CASE
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
(deftest handler-case.1
 
9
  (handler-case
 
10
   (error "an error")
 
11
   (error () t))
 
12
  t)
 
13
 
 
14
(deftest handler-case.2
 
15
  (handler-case
 
16
   (error "an error")
 
17
   (warning () nil)
 
18
   (error () t))
 
19
  t)
 
20
 
 
21
(deftest handler-case.3
 
22
  (handler-case
 
23
   (error "an error")
 
24
   (error (c) (and (typep c 'error) t))
 
25
   (error () 'bad)
 
26
   (condition () 'bad2))
 
27
  t)
 
28
 
 
29
(deftest handler-case.4
 
30
  (handler-case
 
31
   (error "an error")
 
32
   (warning (c) c)
 
33
   (error (c) (and (typep c 'error) t))
 
34
   (error () 'bad)
 
35
   (condition () 'bad2))
 
36
  t)
 
37
 
 
38
(deftest handler-case.5
 
39
  (handler-case
 
40
   (error "an error")
 
41
   (#.(find-class 'error) (c) (and (typep c 'error) t))
 
42
   (error () 'bad))
 
43
  t)
 
44
 
 
45
(deftest handler-case.6
 
46
  (handler-case (values)
 
47
                (error () nil)))
 
48
 
 
49
(deftest handler-case.7
 
50
  (handler-case 'foo (condition () 'bar))
 
51
  foo)
 
52
 
 
53
;;; (deftest handler-case.8
 
54
;;;  (handler-case 'foo (t () 'bar))
 
55
;;;  foo)
 
56
 
 
57
(deftest handler-case.9
 
58
  (handler-case (values 1 2 3 4 5 6 7 8) (condition () nil))
 
59
  1 2 3 4 5 6 7 8)
 
60
 
 
61
;;; (deftest handler-case.10
 
62
;;;  (handler-case
 
63
;;;   (error "foo")
 
64
;;;   (t () 'good))
 
65
;;;  good)
 
66
 
 
67
(deftest handler-case.11
 
68
  (labels ((%f () (declare (special *c*))
 
69
               (and (typep *c* 'condition) t))
 
70
           (%g ()
 
71
               (let ((*c* nil))
 
72
                 (declare (special *c*))
 
73
                 (%h)))
 
74
           (%h ()
 
75
            (handler-case
 
76
             (error "foo")
 
77
             (error (*c*) (declare (special *c*))
 
78
                    (%f)))))
 
79
    (%g))
 
80
  t)
 
81
 
 
82
(deftest handler-case.12
 
83
  (handler-case (error "foo")
 
84
                (nil () nil)
 
85
                (error (c) (notnot-mv (typep c 'simple-error))))
 
86
  t)
 
87
 
 
88
(deftest handler-case.13
 
89
  (handler-case (error "foo")
 
90
                (error (c) (values))))
 
91
 
 
92
(deftest handler-case.14
 
93
  (handler-case (error "foo")
 
94
                (error (c)
 
95
                       (values 1 2 3 4 5 6 7 8)))
 
96
  1 2 3 4 5 6 7 8)
 
97
 
 
98
(deftest handler-case.15
 
99
  (handler-case
 
100
   (handler-case (error "foo")
 
101
                 (warning () 'bad))
 
102
   (error () 'good))
 
103
  good)
 
104
 
 
105
(deftest handler-case.16
 
106
  (handler-case
 
107
   (handler-case (error "foo")
 
108
                 (error () 'good))
 
109
   (error () 'bad))
 
110
  good)
 
111
 
 
112
(deftest handler-case.17
 
113
  (let ((i 0))
 
114
    (values
 
115
     (handler-case
 
116
      (handler-case (error "foo")
 
117
                    (error () (incf i) (error "bar")))
 
118
      (error () 'good))
 
119
     i))
 
120
  good 1)
 
121
 
 
122
(deftest handler-case.18
 
123
  (let ((i 0))
 
124
    (values
 
125
     (handler-case
 
126
      (handler-case (error "foo")
 
127
                    (error (c) (incf i) (error c)))
 
128
      (error () 'good))
 
129
     i))
 
130
  good 1)
 
131
 
 
132
(deftest handler-case.19
 
133
  (handler-case
 
134
   (error "foo")
 
135
   (error (c)
 
136
          ;; Test that declarations can go here
 
137
          (declare (optimize (safety 3)))
 
138
          (declare (type condition c))
 
139
          (declare (ignore c))
 
140
          t))
 
141
  t)
 
142
 
 
143
(deftest handler-case.20
 
144
  (handler-case
 
145
   10
 
146
   (:no-error (x) (+ x 3)))
 
147
  13)
 
148
 
 
149
(deftest handler-case.21
 
150
  (handler-case
 
151
   (values)
 
152
   (:no-error () 'foo))
 
153
  foo)
 
154
 
 
155
(deftest handler-case.22
 
156
  (handler-case
 
157
   (values 1 2 3 4 5)
 
158
   (:no-error (a b c d e) (list e d c b a)))
 
159
  (5 4 3 2 1))
 
160
 
 
161
(deftest handler-case.23
 
162
  (signals-error
 
163
   (handler-case (values 1 2) (:no-error (x) x))
 
164
   program-error)
 
165
  t)
 
166
 
 
167
(deftest handler-case.24
 
168
  (signals-error
 
169
   (handler-case (values) (:no-error (x) x))
 
170
   program-error)
 
171
  t)
 
172
 
 
173
(deftest handler-case.25
 
174
  (handler-case
 
175
   (handler-case
 
176
    (values)
 
177
    (error () 'bad)
 
178
    (:no-error () (error "foo")))
 
179
   (error () 'good))
 
180
  good)
 
181
 
 
182
(deftest handler-case.26
 
183
  (handler-case
 
184
   (values 1 'a 1.0)
 
185
   (error () 'bad)
 
186
   (:no-error (a b c)
 
187
              ;; Test that declarations can go here
 
188
              (declare (type integer a))
 
189
              (declare (type symbol b))
 
190
              (declare (type number c))
 
191
              (declare (ignore a c))
 
192
              b))
 
193
  a)
 
194
 
 
195
(deftest handler-case.27
 
196
  (handler-case (error "foo") (error ()))
 
197
  nil)
 
198
 
 
199
(deftest handler-case.28
 
200
  (handler-case (error "foo") (error () (declare (optimize speed))))
 
201
  nil)