Commit bd65bcea authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Make test-try-refinding more robust vs MKCL

It looks like a bug in MKCL 1.1.9 causes the entire test to be re-run when
the asdf:retry restart is invoked. Use a defvar rather than a lexical
(or a defparameter) to check that an attempt was made, and exit with prejudice
instead of throwing an error.
parent 5e85031c
......@@ -19,22 +19,23 @@
(clear-caches-and-search)
(assert (not (asdf:find-system "test-asdf/force1" nil)))
(DBG "Correctly failed to find system.")
(defvar *attempts* 0)
(assert
(let (tried-once)
(with-asdf-cache (:override t)
(handler-bind
((asdf:missing-component
#'(lambda (c)
(DBG "Caught MISSING-COMPONENT condition.")
(if (not tried-once)
(let ((missing (asdf::missing-requires c)))
(assert (equal missing "test-asdf/force1"))
(setf tried-once t)
(setf asdf:*central-registry* *old-registry*)
(invoke-restart 'asdf:retry))
;; avoid infinite looping
(error c)))))
(asdf:find-system "test-asdf/force1" t)))))
(with-asdf-cache (:override t)
(handler-bind
((asdf:missing-component
#'(lambda (c)
(DBG "Caught MISSING-COMPONENT condition (A)." *attempts*)
(if (zerop *attempts*)
(let ((missing (asdf::missing-requires c)))
(incf *attempts*)
(assert (equal missing "test-asdf/force1"))
(setf asdf:*central-registry* *old-registry*)
(invoke-restart 'asdf:retry))
;; avoid infinite looping
(leave-test 10 "Infinite loop while catching MISSING-COMPONENT")))))
(asdf:find-system "test-asdf/force1" t))))
(assert-equal *attempts* 1)
(DBG "Refinding test successful.")
......@@ -48,36 +49,37 @@
;; (trace find-component)
;; (trace asdf::component-find-path)
;; (trace operate)
(let (tried-once)
(with-asdf-cache (:override t)
(flet ((handle-missing (c)
(if (not tried-once)
(let ((missing (asdf::missing-requires c)))
(assert (equal missing "test-asdf/force1"))
(setf tried-once t)
(DBG "Trying to reset the central registry and retry.")
(setf asdf:*central-registry* *old-registry*)
(unless (find-restart 'asdf:clear-configuration-and-retry)
(error "Expected CLEAR-CONFIGURATION-AND-RETRY restart not found."))
(DBG "Before invoking restart, CENTRAL-REGISTRY is:"
asdf:*central-registry*)
(invoke-restart 'asdf:clear-configuration-and-retry)
(DBG "After invoking restart, CENTRAL-REGISTRY is:"
asdf:*central-registry*))
;; avoid infinite looping
(error c))))
(handler-bind
((asdf:missing-dependency-of-version
#'(lambda (c)
;; Nothing Quicklisp can do to recover from this, so
;; just resignal
(error c)))
(asdf:missing-dependency
#'(lambda (c)
(DBG "Catching MISSING-DEPENDENCY condition:" tried-once)
(handle-missing c)))
(asdf:missing-component
#'(lambda (c)
(DBG "Catching MISSING-COMPONENT condition:" tried-once)
(handle-missing c))))
(asdf:load-system "test-missing-dependency")))))
(setf *attempts* 0)
(with-asdf-cache (:override t)
(flet ((handle-missing (c)
(if (zerop *attempts*)
(let ((missing (asdf::missing-requires c)))
(incf *attempts*)
(assert (equal missing "test-asdf/force1"))
(DBG "Trying to reset the central registry and retry.")
(setf asdf:*central-registry* *old-registry*)
(unless (find-restart 'asdf:clear-configuration-and-retry)
(error "Expected CLEAR-CONFIGURATION-AND-RETRY restart not found."))
(DBG "Before invoking restart, CENTRAL-REGISTRY is:"
asdf:*central-registry*)
(invoke-restart 'asdf:clear-configuration-and-retry)
(DBG "After invoking restart, CENTRAL-REGISTRY is:"
asdf:*central-registry*))
;; avoid infinite looping
(leave-test 11 "Infinite loop while catching MISSING-COMPONENT"))))
(handler-bind
((asdf:missing-dependency-of-version
#'(lambda (c)
;; Nothing Quicklisp can do to recover from this, so
;; just resignal
(error c)))
(asdf:missing-dependency
#'(lambda (c)
(DBG "Catching MISSING-DEPENDENCY condition (B):" *attempts*)
(handle-missing c)))
(asdf:missing-component
#'(lambda (c)
(DBG "Catching MISSING-COMPONENT condition (C):" *attempts*)
(handle-missing c))))
(asdf:load-system "test-missing-dependency"))))
(assert-equal *attempts* 1)
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