restart-case.lsp 7.34 KB
Newer Older
pfdietz's avatar
pfdietz committed
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Mar 22 06:58:03 2003
;;;; Contains: Tests for RESTART-CASE

6

pfdietz's avatar
pfdietz committed
7 8 9 10 11 12 13 14 15 16 17 18 19 20

(deftest restart-case.1
  (restart-case (values)))

(deftest restart-case.2
  (restart-case 1)
  1)

(deftest restart-case.3
  (restart-case (values 'a 'b 'c 'd 'e 'f))
  a b c d e f)

(deftest restart-case.4
  (restart-case (progn (invoke-restart 'foo) 'bad)
sds's avatar
sds committed
21
                (foo () 'good))
pfdietz's avatar
pfdietz committed
22 23 24 25
  good)

(deftest restart-case.5
  (restart-case (progn (invoke-restart 'foo) 'bad)
sds's avatar
sds committed
26
                (foo ()))
pfdietz's avatar
pfdietz committed
27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69
  nil)

(deftest restart-case.6
  (restart-case
   (progn (invoke-restart 'foo) 'bad)
   (bar () 'bad2)
   (foo () 'good)
   (foo () 'bad3))
  good)

(deftest restart-case.7
  (restart-case
   (invoke-restart 'foo 'a 'b 'c 'd)
   (foo (w x y z) (list z y x w)))
  (d c b a))

(deftest restart-case.8
  (restart-case
   (invoke-restart 'foo :a 1 :b 2)
   (foo (&key a b c d) (list a b c d)))
  (1 2 nil nil))

(deftest restart-case.9
  (restart-case
   (invoke-restart 'foo 1 2 3 4)
   (foo (&rest args) (reverse args)))
  (4 3 2 1))

(deftest restart-case.10
  (restart-case
   (invoke-restart 'foo 1 2 3)
   (foo (a b &optional c d) (list a b c d)))
  (1 2 3 nil))

(deftest restart-case.11
  (restart-case
   (invoke-restart 'foo 1 2)
   (foo (x y) (declare (type fixnum x y)) (+ x y)))
  3)

(deftest restart-case.12
  (restart-case
   (restart-case (invoke-restart 'foo 1)
sds's avatar
sds committed
70
                 (foo (x) (invoke-restart 'foo (1+ x))))
pfdietz's avatar
pfdietz committed
71 72 73 74 75 76 77
   (foo (y) (+ 4 y)))
  6)

(deftest restart-case.13
  (let ((i 10))
    (values
     (restart-case (progn (invoke-restart 'foo) 'bad)
sds's avatar
sds committed
78
                   (foo () (incf i 100) 'good))
pfdietz's avatar
pfdietz committed
79 80 81 82 83 84 85
     i))
  good 110)

(deftest restart-case.14
  (restart-case
   (invoke-restart 'foo 1 2)
   (foo (x y)
sds's avatar
sds committed
86 87 88
        (declare (type fixnum x))
        (declare (type fixnum y))
        (+ x y)))
pfdietz's avatar
pfdietz committed
89 90 91 92 93 94
  3)

(deftest restart-case.15
  (restart-case
   (invoke-restart 'foo 1 2)
   (foo (x y)
sds's avatar
sds committed
95 96 97
        (declare (ignore x y))
        (declare (type fixnum x))
        (declare (type fixnum y))))
pfdietz's avatar
pfdietz committed
98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128
  nil)

(deftest restart-case.16
  (restart-case
   (invoke-restart 'foo)
   (foo () (values))))

(deftest restart-case.17
  (restart-case
   (invoke-restart 'foo)
   (foo () (values 'a 'b 'c 'd 'e 'f)))
  a b c d e f)

(deftest restart-case.18
  (restart-case
   (invoke-restart 'foo)
   (foo () :test (lambda (c) (declare (ignore c)) t) 'good))
  good)

(deftest restart-case.19
  (restart-case
   (invoke-restart 'foo)
   (foo () :test (lambda (c) (declare (ignore c)) nil) 'bad)
   (foo () 'good))
  good)

(deftest restart-case.20
  (with-output-to-string
    (s)
    (restart-case
     (let ((restart (find-restart 'foo))
sds's avatar
sds committed
129
           (*print-escape* nil))
pfdietz's avatar
pfdietz committed
130 131 132 133 134 135 136 137 138 139
       (format s "~A" restart))
     (foo () :report "A report")))
  "A report")

(deftest restart-case.21
  (with-output-to-string
    (s)
    (flet ((%f (s2) (format s2 "A report")))
      (restart-case
       (let ((restart (find-restart 'foo))
sds's avatar
sds committed
140 141
             (*print-escape* nil))
         (format s "~A" restart))
pfdietz's avatar
pfdietz committed
142 143 144 145 146 147 148 149
       (foo () :report %f))))
  "A report")

(deftest restart-case.22
  (with-output-to-string
    (s)
    (restart-case
     (let ((restart (find-restart 'foo))
sds's avatar
sds committed
150
           (*print-escape* nil))
pfdietz's avatar
pfdietz committed
151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178
       (format s "~A" restart))
     (foo () :report (lambda (s2) (format s2 "A report")))))
  "A report")

;;; Special cases when restart-case associates the restarts with
;;; a condition

(deftest restart-case.23
  (handler-bind
   ((error #'(lambda (c) (declare (ignore c)) (invoke-restart 'foo))))
   (restart-case
    (error "Boo!")
    (foo () 'good)))
  good)

(deftest restart-case.24
  (handler-bind
   ((error #'(lambda (c) (invoke-restart (find-restart 'foo c)))))
   (restart-case
    (error "Boo!")
    (foo () 'good)))
  good)


;;; Test that the inner restart-case has associated its restart with
;;; the condition to be raised by the error form.

(deftest restart-case.25
179 180 181 182 183
  (handler-bind
   ((error #'(lambda (c2) (invoke-restart (find-restart 'foo c2)))))
   (handler-bind
    ((error #'(lambda (c) (declare (ignore c)) (error "Blah"))))
    (restart-case
pfdietz's avatar
pfdietz committed
184
     (restart-case
185 186 187
      (error "Boo!")
      (foo () 'bad))
     (foo () 'good))))
pfdietz's avatar
pfdietz committed
188 189
  good)

190
(deftest restart-case.26
191 192 193 194 195
  (handler-bind
   ((error #'(lambda (c2) (invoke-restart (find-restart 'foo c2)))))
   (handler-bind
    ((simple-condition #'(lambda (c) (declare (ignore c)) (error "Blah"))))
    (restart-case
196
     (restart-case
197 198 199
      (signal "Boo!")
      (foo () 'bad))
     (foo () 'good))))
200 201 202
  good)

(deftest restart-case.27
203 204 205 206 207
  (handler-bind
   ((error #'(lambda (c2) (invoke-restart (find-restart 'foo c2)))))
   (handler-bind
    ((error #'(lambda (c) (declare (ignore c)) (error "Blah"))))
    (restart-case
208
     (restart-case
209 210 211
      (cerror "" "")
      (foo () 'bad))
     (foo () 'good))))
212
  good)
pfdietz's avatar
pfdietz committed
213

214
(deftest restart-case.28
215 216 217 218 219
  (handler-bind
   ((error #'(lambda (c2) (invoke-restart (find-restart 'foo c2)))))
   (handler-bind
    ((warning #'(lambda (c) (declare (ignore c)) (error "Blah"))))
    (restart-case
220
     (restart-case
221 222 223
      (warn "Boo!")
      (foo () 'bad))
     (foo () 'good))))
224 225 226 227
  good)

(deftest restart-case.29
  (macrolet ((%m (&rest args) (cons 'error args)))
228 229 230 231 232
    (handler-bind
     ((error #'(lambda (c2) (invoke-restart (find-restart 'foo c2)))))
     (handler-bind
      ((error #'(lambda (c) (declare (ignore c)) (error "Blah"))))
      (restart-case
233
       (restart-case
sds's avatar
sds committed
234 235
        (%m "Boo!")
        (foo () 'bad))
236
       (foo () 'good)))))
237 238 239
  good)

(deftest restart-case.30
240 241 242 243 244 245
  (symbol-macrolet ((%s (error "Boo!")))
    (handler-bind
     ((error #'(lambda (c2) (invoke-restart (find-restart 'foo c2)))))
     (handler-bind
      ((error #'(lambda (c) (declare (ignore c)) (error "Blah"))))
      (restart-case
246
       (restart-case
sds's avatar
sds committed
247 248
        %s
        (foo () 'bad))
249
       (foo () 'good)))))
250
  good)
pfdietz's avatar
pfdietz committed
251

252 253 254
(deftest restart-case.31
  (macrolet ((%m2 (&rest args) (cons 'error args)))
    (macrolet ((%m (&rest args &environment env)
sds's avatar
sds committed
255
                   (macroexpand (cons '%m2 args) env)))
256 257 258
      (handler-bind
       ((error #'(lambda (c2) (invoke-restart (find-restart 'foo c2)))))
       (handler-bind
sds's avatar
sds committed
259 260 261 262 263 264
        ((error #'(lambda (c) (declare (ignore c)) (error "Blah"))))
        (restart-case
         (restart-case
          (%m "Boo!")
          (foo () 'bad))
         (foo () 'good))))))
265 266
  good)

267 268 269 270 271 272 273 274 275 276
(deftest restart-case.32
  (restart-case
   (invoke-restart-interactively 'foo)
   (foo () 'good))
  good)

(deftest restart-case.33
  (restart-case
   (invoke-restart-interactively 'foo)
   (foo (w x y z)
sds's avatar
sds committed
277 278
        :interactive (lambda () (list 'a 'b 'c 'd))
        (list x w z y)))
279 280 281 282 283 284 285
  (b a d c))

(deftest restart-case.34
  (flet ((%f () (list 'a 'b 'c 'd)))
    (restart-case
     (invoke-restart-interactively 'foo)
     (foo (w x y z)
sds's avatar
sds committed
286 287
          :interactive %f
          (list x w z y))))
288 289
  (b a d c))

290 291 292
(deftest restart-case.35
  (restart-case
   (loop for i from 1 to 4
sds's avatar
sds committed
293 294
         for r in (compute-restarts)
         collect (restart-name r))
295 296 297 298 299 300
   (foo () t)
   (bar () t)
   (foo () 'a)
   (nil () :report (lambda (s) (format s "Anonymous restart"))  10))
  (foo bar foo nil))

301 302 303 304 305 306 307
(deftest restart-case.36
  (let ((x :bad))
    (declare (special x))
    (let ((x :good))
      (restart-case
       (invoke-restart 'foo)
       (foo (&aux (y x))
sds's avatar
sds committed
308 309 310
            (declare (special x))
            y))))
  :good)
311 312 313 314 315 316 317 318

(deftest restart-case.37
    (progn
      (define-condition x () ((y :initarg :y)))
      (handler-bind ((x (lambda (c) (slot-value c 'y))))
        (restart-case
            (signal 'x :y 1))))
  nil)