diff --git a/ansi-tests/restart-bind.lsp b/ansi-tests/restart-bind.lsp index d8b011904077c14f0798b99ba61b2078e3015d5a..d075621d2f8f494379e0c531ef63e9949cbc3819 100644 --- a/ansi-tests/restart-bind.lsp +++ b/ansi-tests/restart-bind.lsp @@ -87,6 +87,123 @@ (%f)))) good) +(deftest restart-bind.14 + (let ((x 10) (y nil)) + (restart-bind + ((foo #'(lambda () + (when (> x 0) + (push 'a y) + (decf x) + (invoke-restart 'foo)) + y))) + (invoke-restart 'foo))) + (a a a a a a a a a a)) + +(deftest restart-bind.15 + (block done + (let ((i 0)) + (restart-bind ((foo (progn (incf i) + #'(lambda () (return-from done i))))) + (invoke-restart 'foo) + 'bad))) + 1) + +(deftest restart-bind.16 + (let ((i 0)) + (values + (with-output-to-string + (s) + (restart-bind + ((foo #'(lambda () nil) + :report-function (progn (incf i) + #'(lambda (s) (format s "A report"))))) + (let ((*print-escape* nil)) + (format s "~A" (find-restart 'foo))))) + i)) + "A report" + 1) + +(deftest restart-bind.17 + (restart-bind + ((foo #'(lambda () 'good)) + (foo #'(lambda () 'bad))) + (invoke-restart 'foo)) + good) + +(deftest restart-bind.18 + (restart-bind + ((foo #'(lambda () 'good)) + (bar #'(lambda () 'bad))) + (invoke-restart 'foo)) + good) + +(deftest restart-bind.19 + (restart-bind + ((foo #'(lambda () 'bad)) + (bar #'(lambda () 'good))) + (invoke-restart 'bar)) + good) + +;;; Using the :test-function to associate a restart with a condition + +(deftest restart-bind.20 + (let ((c (make-condition 'error))) + (restart-bind + ((foo #'(lambda () 'bad) + :test-function #'(lambda (c1) (not (eq c c1)))) + (foo #'(lambda () 'good) + :test-function #'(lambda (c2) (or (null c2) + (eq c c2))))) + (invoke-restart (find-restart 'foo c)))) + good) + +(deftest restart-bind.21 + (let ((c (make-condition 'error))) + (restart-bind + ((foo #'(lambda () 'bad) + :test-function #'(lambda (c1) nil)) + (foo #'(lambda () 'good) + :test-function #'(lambda (c2) t))) + (invoke-restart (find-restart 'foo c)))) + good) + +(deftest restart-bind.22 + (let ((c (make-condition 'error)) + (i 0)) + (values + (restart-bind + ((foo #'(lambda () 'good) + :test-function (progn (incf i) #'(lambda (c2) t)))) + (invoke-restart (find-restart 'foo c))) + i)) + good + 1) + +;;; Error tests + +(deftest restart-bind.error.1 + (classify-error + (restart-bind + ((foo #'(lambda () t))) + (invoke-restart 'foo 'a))) + program-error) + +(deftest restart-bind.error.2 + (classify-error + (restart-bind + ((foo #'(lambda (x) x))) + (invoke-restart 'foo))) + program-error) + +(deftest restart-bind.error.3 + (classify-error + (restart-bind + ((foo #'identity)) + (invoke-restart 'foo))) + program-error) + +;;; Must still add interactive-function tests +