;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Mar 22 06:58:03 2003
;;;; Contains: Tests for RESTART-CASE



(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)
                (foo () 'good))
  good)

(deftest restart-case.5
  (restart-case (progn (invoke-restart 'foo) 'bad)
                (foo ()))
  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)
                 (foo (x) (invoke-restart 'foo (1+ x))))
   (foo (y) (+ 4 y)))
  6)

(deftest restart-case.13
  (let ((i 10))
    (values
     (restart-case (progn (invoke-restart 'foo) 'bad)
                   (foo () (incf i 100) 'good))
     i))
  good 110)

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

(deftest restart-case.15
  (restart-case
   (invoke-restart 'foo 1 2)
   (foo (x y)
        (declare (ignore x y))
        (declare (type fixnum x))
        (declare (type fixnum y))))
  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))
           (*print-escape* nil))
       (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))
             (*print-escape* nil))
         (format s "~A" restart))
       (foo () :report %f))))
  "A report")

(deftest restart-case.22
  (with-output-to-string
    (s)
    (restart-case
     (let ((restart (find-restart 'foo))
           (*print-escape* nil))
       (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
  (handler-bind
   ((error #'(lambda (c2) (invoke-restart (find-restart 'foo c2)))))
   (handler-bind
    ((error #'(lambda (c) (declare (ignore c)) (error "Blah"))))
    (restart-case
     (restart-case
      (error "Boo!")
      (foo () 'bad))
     (foo () 'good))))
  good)

(deftest restart-case.26
  (handler-bind
   ((error #'(lambda (c2) (invoke-restart (find-restart 'foo c2)))))
   (handler-bind
    ((simple-condition #'(lambda (c) (declare (ignore c)) (error "Blah"))))
    (restart-case
     (restart-case
      (signal "Boo!")
      (foo () 'bad))
     (foo () 'good))))
  good)

(deftest restart-case.27
  (handler-bind
   ((error #'(lambda (c2) (invoke-restart (find-restart 'foo c2)))))
   (handler-bind
    ((error #'(lambda (c) (declare (ignore c)) (error "Blah"))))
    (restart-case
     (restart-case
      (cerror "" "")
      (foo () 'bad))
     (foo () 'good))))
  good)

(deftest restart-case.28
  (handler-bind
   ((error #'(lambda (c2) (invoke-restart (find-restart 'foo c2)))))
   (handler-bind
    ((warning #'(lambda (c) (declare (ignore c)) (error "Blah"))))
    (restart-case
     (restart-case
      (warn "Boo!")
      (foo () 'bad))
     (foo () 'good))))
  good)

(deftest restart-case.29
  (macrolet ((%m (&rest args) (cons 'error args)))
    (handler-bind
     ((error #'(lambda (c2) (invoke-restart (find-restart 'foo c2)))))
     (handler-bind
      ((error #'(lambda (c) (declare (ignore c)) (error "Blah"))))
      (restart-case
       (restart-case
        (%m "Boo!")
        (foo () 'bad))
       (foo () 'good)))))
  good)

(deftest restart-case.30
  (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
       (restart-case
        %s
        (foo () 'bad))
       (foo () 'good)))))
  good)

(deftest restart-case.31
  (macrolet ((%m2 (&rest args) (cons 'error args)))
    (macrolet ((%m (&rest args &environment env)
                   (macroexpand (cons '%m2 args) env)))
      (handler-bind
       ((error #'(lambda (c2) (invoke-restart (find-restart 'foo c2)))))
       (handler-bind
        ((error #'(lambda (c) (declare (ignore c)) (error "Blah"))))
        (restart-case
         (restart-case
          (%m "Boo!")
          (foo () 'bad))
         (foo () 'good))))))
  good)

(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)
        :interactive (lambda () (list 'a 'b 'c 'd))
        (list x w z y)))
  (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)
          :interactive %f
          (list x w z y))))
  (b a d c))

(deftest restart-case.35
  (restart-case
   (loop for i from 1 to 4
         for r in (compute-restarts)
         collect (restart-name r))
   (foo () t)
   (bar () t)
   (foo () 'a)
   (nil () :report (lambda (s) (format s "Anonymous restart"))  10))
  (foo bar foo nil))

(deftest restart-case.36
  (let ((x :bad))
    (declare (special x))
    (let ((x :good))
      (restart-case
       (invoke-restart 'foo)
       (foo (&aux (y x))
            (declare (special x))
            y))))
  :good)

(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)