← Back to branch summary

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

« back to all changes in this revision

Viewing changes to ansi-tests/unwind-protect.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/unwind-protect.lsp
 
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