source: trunk/source/tests/ansi-tests/with-condition-restarts.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: 2.1 KB
RevLine 
[8991]1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Mar 23 04:06:06 2003
4;;;; Contains: Tests of WITH-CONDITION-RESTARTS
5
6(in-package :cl-test)
7
8(deftest with-condition-restarts.1
9  (let (a b c (i 0))
10    (values
11     (with-condition-restarts
12      (progn (setf a (incf i)) (make-condition 'error))
13      (progn (setf b (incf i)) nil)
14      (setf c (incf i)))
15     a b c i))
16  3 1 2 3 3)
17
18(deftest with-condition-restarts.2
19  (with-condition-restarts
20   (make-condition 'error)
21   nil
22   (values)))
23
24(deftest with-condition-restarts.3
25  (with-condition-restarts
26   (make-condition 'error)
27   nil
28   (values 'a 'b 'c 'd 'e 'f))
29  a b c d e f)
30
31(deftest with-condition-restarts.4
32  (block done
33    (tagbody
34     (with-condition-restarts
35      (make-condition 'error)
36      nil
37      (go 10)
38      10
39      (return-from done 'bad))
40     10
41     (return-from done 'good)))
42  good)
43
44(deftest with-condition-restarts.5
45  (let ((c (make-condition 'error)))
46    (restart-case
47     (with-condition-restarts
48      c
49      (list (find-restart 'foo))
50      'good)
51     (foo () 'bad)))
52  good)
53
54(deftest with-condition-restarts.6
55  (let ((c (make-condition 'error))
56        (c2 (make-condition 'error)))
57    (handler-bind
58     ((error #'(lambda (c) (invoke-restart (find-restart 'foo c2)))))
59     (restart-case
60      (with-condition-restarts
61       c
62       (list (find-restart 'foo))
63       (signal c2))
64      (foo () 'bad)
65      (foo () 'good))))
66  good)
67
68(deftest with-condition-restarts.7
69  (let ((c (make-condition 'error))
70        (c2 (make-condition 'error)))
71    (handler-bind
72     ((error #'(lambda (c) (invoke-restart 'foo))))
73     (restart-case
74      (with-condition-restarts
75       c
76       (list (find-restart 'foo))
77       (signal c2))
78      (foo () 'good)
79      (foo () 'bad))))
80  good)
81
82;;; test that the association of a restart with a condition
83;;; has dynamic extent
84
85(deftest with-condition-restarts.8
86  (let ((c (make-condition 'error))
87        (c2 (make-condition 'error)))
88    (restart-case
89     (progn
90       (with-condition-restarts
91        c
92        (list (find-restart 'foo)))
93       (invoke-restart (find-restart 'foo c2)))
94     (foo () 'good)
95     (foo () 'bad)))
96  good)
Note: See TracBrowser for help on using the repository browser.