source: trunk/source/tests/ansi-tests/compute-restarts.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: 3.0 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Mar 22 23:48:53 2003
4;;;; Contains: Tests of COMPUTE-RESTARTS
5
6(in-package :cl-test)
7
8(deftest compute-restarts.1
9  (loop for r in (compute-restarts)
10        always (typep r 'restart))
11  t)
12
13(deftest compute-restarts.2
14  (loop for r in (compute-restarts)
15        always (typep r (find-class 'restart)))
16  t)
17
18(deftest compute-restarts.3
19  (restart-case
20   (let ((r (find-restart 'foo)))
21     (eqt r (find 'foo (compute-restarts) :key #'restart-name)))
22   (foo () nil))
23  t)
24
25(deftest compute-restarts.4
26  (loop for r1 in (compute-restarts)
27        for r2 in (compute-restarts)
28        always (eq r1 r2))
29  t)
30
31(deftest compute-restarts.5
32  (restart-case
33   (loop for r1 in (compute-restarts)
34         for r2 in (compute-restarts)
35         always (eq r1 r2))
36   (foo () t)
37   (bar () t)
38   (foo () nil))
39  t)
40
41(deftest compute-restarts.6
42  (restart-case
43   (let* ((restarts (compute-restarts))
44          (p (position 'foo restarts :key #'restart-name))
45          (r (find 'foo restarts :start (1+ p) :key #'restart-name)))
46     (invoke-restart r))
47   (foo () 'bad)
48   (foo () 'good)
49   (foo () 'bad))
50  good)
51
52(deftest compute-restarts.7
53  (handler-bind
54   ((error #'(lambda (c)
55               (let* ((restarts (compute-restarts c))
56                      (r (remove 'foo restarts
57                                 :test-not #'eq
58                                 :key #'restart-name)))
59                 (invoke-restart (second r))))))
60   (restart-case
61    (error "an error")
62    (foo () 'bad)
63    (foo () 'good)
64    (foo () 'bad)))
65  good)
66
67(deftest compute-restarts.8
68  (handler-bind
69   ((error #'(lambda (c)
70               (declare (ignore c))
71               (let* ((restarts (compute-restarts))
72                      (r (remove 'foo restarts
73                                 :test-not #'eq
74                                 :key #'restart-name)))
75                 (invoke-restart (second r))))))
76   (restart-case
77    (error "an error")
78    (foo () 'bad)
79    (foo () 'good)
80    (foo () 'bad)))
81  good)
82
83(deftest compute-restarts.9
84  (let ((c2 (make-condition 'error)))
85    (block done
86      (handler-bind
87       ((error #'(lambda (c)
88                   (declare (ignore c))
89                   (let* ((restarts (compute-restarts c2))
90                          (r (remove 'foo restarts
91                                     :test-not #'eq
92                                     :key #'restart-name)))
93                     ;; (write restarts)
94                     (return-from done
95                       (values r
96                               (mapcar #'restart-name r)))))))
97       (restart-case
98        (error "an error")
99        (foo () 'bad)
100        (foo () 'also-bad)))))
101  nil nil)
102
103;;; This test is disabled until I figure out how to fix
104;;; it.  See sbcl-devel mailing list, Oct 2005
105#|
106(deftest compute-restarts.10
107  (let ((c2 (make-condition 'error)))
108    (block done
109      (handler-bind
110       ((error #'(lambda (c)
111                   (declare (ignore c))
112                   (let* ((restarts (compute-restarts c2))
113                          (r (remove 'foo restarts
114                                     :test-not #'eq
115                                     :key #'restart-name)))
116                     ;; (write restarts)
117                     (return-from done
118                       (values r
119                               (mapcar #'restart-name r)))))))
120       (restart-case
121        (progn (error "an error"))
122        (foo () :test (lambda (c) (or (null c) (not (eq c c2))))
123             'bad)
124        (foo () :test (lambda (c) (or (null c) (not (eq c c2))))
125             'also-bad)))))
126  nil nil)
127|#
128
129
130
131
Note: See TracBrowser for help on using the repository browser.