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

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
Loading
Loading
Loading
Loading
+50 −48
Original line number Diff line number Diff line
@@ -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)
             (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 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)))))
                 (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,13 +49,13 @@
;; (trace find-component)
;; (trace asdf::component-find-path)
;; (trace operate)
(let (tried-once)
(setf *attempts* 0)
(with-asdf-cache (:override t)
  (flet ((handle-missing (c)
             (if (not tried-once)
           (if (zerop *attempts*)
               (let ((missing (asdf::missing-requires c)))
                 (incf *attempts*)
                 (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)
@@ -65,7 +66,7 @@
                 (DBG "After invoking restart, CENTRAL-REGISTRY is:"
                      asdf:*central-registry*))
               ;; avoid infinite looping
                 (error c))))
               (leave-test 11 "Infinite loop while catching MISSING-COMPONENT"))))
    (handler-bind
        ((asdf:missing-dependency-of-version
          #'(lambda (c)
@@ -74,10 +75,11 @@
              (error c)))
         (asdf:missing-dependency
          #'(lambda (c)
                 (DBG "Catching MISSING-DEPENDENCY condition:" tried-once)
              (DBG "Catching MISSING-DEPENDENCY condition (B):" *attempts*)
              (handle-missing c)))
         (asdf:missing-component
          #'(lambda (c)
                 (DBG "Catching MISSING-COMPONENT condition:" tried-once)
              (DBG "Catching MISSING-COMPONENT condition (C):" *attempts*)
              (handle-missing c))))
        (asdf:load-system "test-missing-dependency")))))
      (asdf:load-system "test-missing-dependency"))))
(assert-equal *attempts* 1)