source: trunk/source/tests/ansi-tests/unwind-protect.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: 2.4 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Oct 12 14:41:16 2002
4;;;; Contains: Tests of UNWIND-PROTECT
5
6(in-package :cl-test)
7
8(deftest unwind-protect.1
9  (let ((x nil))
10    (unwind-protect
11        (push 1 x)
12      (incf (car x))))
13  (2))
14
15(deftest unwind-protect.2
16  (let ((x nil))
17    (block foo
18      (unwind-protect
19          (progn (push 1 x) (return-from foo x))
20        (incf (car x)))))
21  (2))
22
23(deftest unwind-protect.3
24  (let ((x nil))
25    (tagbody
26      (unwind-protect
27          (progn (push 1 x) (go done))
28        (incf (car x)))
29      done)
30    x)
31  (2))
32
33(deftest unwind-protect.4
34  (let ((x nil))
35    (catch 'done
36      (unwind-protect
37          (progn (push 1 x) (throw 'done x))
38        (incf (car x)))))
39  (2))
40
41(deftest unwind-protect.5
42  (let ((x nil))
43    (ignore-errors
44      (unwind-protect
45          (progn (push 1 x) (error "Boo!"))
46        (incf (car x))))
47    x)
48  (2))
49
50(deftest unwind-protect.6
51  (let ((x nil))
52    (block done
53      (flet ((%f () (return-from done nil)))
54        (unwind-protect (%f)
55          (push 'a x))))
56    x)
57  (a))
58
59(deftest unwind-protect.7
60  (let ((x nil))
61    (block done
62      (flet ((%f () (return-from done nil)))
63        (unwind-protect
64            (unwind-protect (%f)
65              (push 'b x))
66          (push 'a x))))
67    x)
68  (a b))
69
70(deftest unwind-protect.8
71  (let ((x nil))
72    (block done
73      (unwind-protect
74          (flet ((%f () (return-from done nil)))
75            (unwind-protect
76                (unwind-protect (%f)
77                  (push 'b x))
78              (push 'a x)))
79        (push 'c x)))
80    x)
81  (c a b))
82
83(deftest unwind-protect.9
84  (let ((x nil))
85    (handler-case
86      (flet ((%f () (error 'type-error :datum 'foo :expected-type nil)))
87        (unwind-protect (handler-case (%f))
88          (push 'a x)))
89      (type-error () x)))
90  (a))
91
92;;; No implicit tagbody
93(deftest unwind-protect.10
94  (block done
95    (tagbody
96     (unwind-protect
97         'foo
98       (go 10)
99       10
100       (return-from done 'bad))
101     10
102     (return-from done 'good)))
103  good)
104
105;;; Executes all forms of the implicit progn
106(deftest unwind-protect.11
107  (let ((x nil) (y nil))
108    (values
109     (block nil
110       (unwind-protect (return 'a)
111         (setf y 'c)
112         (setf x 'b)))
113     x y))
114  a b c)
115
116;;; Test that explicit calls to macroexpand in subforms
117;;; are done in the correct environment
118
119(deftest unwind-protect.12
120  (macrolet
121   ((%m (z) z))
122   (unwind-protect (expand-in-current-env (%m :good)) :bad))
123  :good)
124
125(deftest unwind-protect.13
126  (macrolet
127   ((%m (z) z))
128   (unwind-protect :good (expand-in-current-env (%m :bad))))
129  :good)
130
131
Note: See TracBrowser for help on using the repository browser.