source: trunk/source/tests/ansi-tests/handler-bind.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 3.1 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Fri Feb 28 22:07:25 2003
4;;;; Contains: Tests of HANDLER-BIND
5
6(in-package :cl-test)
7
8(deftest handler-bind.1
9  (handler-bind ())
10  nil)
11
12(deftest handler-bind.2
13  (handler-bind () (values)))
14
15(deftest handler-bind.3
16  (handler-bind () (values 1 2 3))
17  1 2 3)
18
19(deftest handler-bind.4
20  (let ((x 0))
21    (values
22     (handler-bind () (incf x) (+ x 10))
23     x))
24  11 1)
25
26(deftest handler-bind.5
27  (block foo
28    (handler-bind ((error #'(lambda (c) (return-from foo 'good))))
29                  (error "an error")))
30  good)
31
32(deftest handler-bind.6
33  (block foo
34    (handler-bind
35     ((error #'(lambda (c) (return-from foo 'good))))
36     (handler-bind ((error #'(lambda (c) (error c)))
37                    (error #'(lambda (c) (return-from foo 'bad))))
38                   (error "an error"))))
39  good)
40
41(defun handler-bind.7-handler-fn (c)
42  (declare (ignore c))
43  (throw 'foo 'good))
44
45(deftest handler-bind.7
46  (catch 'foo
47    (handler-bind ((simple-error #'handler-bind.7-handler-fn))
48                  (error "simple error")))
49  good)
50
51(deftest handler-bind.8
52  (catch 'foo
53    (handler-bind ((simple-error 'handler-bind.7-handler-fn))
54                  (error "simple error")))
55  good)
56
57(deftest handler-bind.9
58  (catch 'foo
59    (handler-bind ((simple-error #.(symbol-function
60                                    'handler-bind.7-handler-fn)))
61                  (error "simple error")))
62  good)
63
64(deftest handler-bind.10
65  (block done
66    (flet ((%foo () (signal "A simple condition"))
67           (%succeed (c) (declare (ignore c)) (return-from done 'good))
68           (%fail (c) (declare (ignore c)) (return-from done 'bad)))
69      (handler-bind
70       ((error #'%fail)
71        (simple-condition #'%succeed))
72       (%foo))))
73  good)
74
75(deftest handler-bind.11
76  (block done
77    (handler-bind
78     ((error #'(lambda (c) c))
79      (error #'(lambda (c) (declare (ignore c)) (return-from done 'good))))
80     (error "an error")))
81  good)
82
83(deftest handler-bind.12
84  (block done
85    (handler-bind
86     ((error #'(lambda (c) (declare (ignore c)) (return-from done 'good))))
87     (handler-bind
88      ((error #'(lambda (c) c)))
89      (error "an error"))))
90  good)
91
92(deftest handler-bind.13
93  (handler-bind
94   ((error #'(lambda (c) (declare (ignore c))
95               (throw 'done 'good))))
96   (catch 'done
97     (error "an error")))
98  good)
99
100(deftest handler-bind.14
101  (catch 'done
102    (handler-bind
103     ((symbol #'identity)  ;; can never succeed
104      (error #'(lambda (c) (declare (ignore c))
105                 (throw 'done 'good))))
106     (error "an error")))
107  good)
108
109(deftest handler-bind.15
110  (catch 'done
111    (handler-bind
112     ((nil #'(lambda (c) (declare (ignore c))
113               (throw 'done 'bad)))
114      (error #'(lambda (c) (declare (ignore c))
115                 (throw 'done 'good))))
116     (error "an error")))
117  good)
118
119(deftest handler-bind.16
120  (catch 'done
121    (handler-bind
122     (((not error) #'identity)
123      (error
124       #'(lambda (c) (declare (ignore c))
125           (throw 'done 'good))))
126     (error "an error")))
127  good)
128
129(deftest handler-bind.17
130  (catch 'done
131    (handler-bind
132     ((#.(find-class 'error)
133         #'(lambda (c) (declare (ignore c))
134             (throw 'done 'good))))
135     (error "an error")))
136  good)
137
138;;; More handler-bind tests elsewhere
139
140
141
142 
143               
144
145               
146 
Note: See TracBrowser for help on using the repository browser.