Commit a7748dc5 authored by pfdietz's avatar pfdietz

Modify correctable error tests so that if a continue restart is available, we...

Modify correctable error tests so that if a continue restart is available, we first try to invoke it.
parent f8868f7e
......@@ -164,16 +164,27 @@
(isym (intern name pkg))
(outer-restarts (compute-restarts)))
(block done
(handler-bind
((package-error
#'(lambda (c)
;; There should be at least one restart
;; associated with this condition that was
;; not a preexisting restart
(assert (set-difference (compute-restarts c)
outer-restarts))
(return-from done :good))))
(import sym pkg)))))
(and
(handler-bind
((package-error
#'(lambda (c)
;; There should be at least one restart
;; associated with this condition that was
;; not a preexisting restart
(let ((my-restarts
(remove 'abort
(set-difference (compute-restarts c)
outer-restarts)
:key #'restart-name)))
(assert my-restarts)
(unintern isym)
(when (find 'continue my-restarts :key #'restart-name)
(continue c))
(return-from done :good)))))
(import sym pkg))
(eqlt (find-symbol name pkg) sym)
(eqlt (symbol-package sym) (find-package "CL-TEST"))
:good))))
:good)
......@@ -186,14 +197,25 @@
(isym (shadow name pkg)) ;; shadow instead of intern
(outer-restarts (compute-restarts)))
(block done
(handler-bind
((package-error
#'(lambda (c)
;; There should be at least one restart
;; associated with this condition that was
;; not a preexisting restart
(assert (set-difference (compute-restarts c)
outer-restarts))
(return-from done :good))))
(import sym pkg)))))
(and
(handler-bind
((package-error
#'(lambda (c)
;; There should be at least one restart
;; associated with this condition that was
;; not a preexisting restart
(let ((my-restarts
(remove 'abort
(set-difference (compute-restarts c)
outer-restarts)
:key #'restart-name)))
(assert my-restarts)
(unintern isym)
(when (find 'continue my-restarts :key #'restart-name)
(continue c))
(return-from done :good)))))
(import sym pkg))
(eqlt (find-symbol name pkg) sym)
(eqlt (symbol-package sym) (find-package "CL-TEST"))
:good))))
:good)
......@@ -79,13 +79,18 @@
(handler-bind ((package-error
#'(lambda (c)
;; (let ((r (find-restart 'continue c))) (and r (invoke-restart r)))
(assert (set-difference (compute-restarts c)
outer-restarts))
(return t)
)))
(let ((my-restarts
(remove 'abort
(set-difference (compute-restarts c)
outer-restarts)
:key #'restart-name)))
(assert my-restarts)
(when (find 'continue my-restarts :key #'restart-name)
(continue c))
(return t)
))))
(delete-package p2)))
#|
(unless (and (equal (package-name P1) "P1")
(null (package-name P2))
(equal (package-name P3) "P3"))
......@@ -119,7 +124,6 @@
(safely-delete-package P3)
(safely-delete-package P1)
(return t)
|#
)
t)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment