test-try-refinding.script 3.11 KB
Newer Older
Robert P. Goldman's avatar
Robert P. Goldman committed
1 2 3 4 5 6 7 8 9 10 11 12
;;; -*- Lisp -*-

;;; test retrying finding location of an ASDF system.


(in-package asdf-test)
(defparameter *old-registry* asdf:*central-registry*)
;;(defparameter *search-table* (hash-table->alist asdf::*source-registry*))
;;(pprint *search-table*)
;;(terpri)
(assert (asdf:find-system "test-asdf/force1"))

13 14
(defun clear-caches-and-search ()
  (setf asdf:*central-registry* nil)
15 16
  (clear-system "test-asdf")
  (clear-system "test-asdf/force1"))
17

Robert P. Goldman's avatar
Robert P. Goldman committed
18
(DBG "Clearing the caches and finding.")
19
(clear-caches-and-search)
Robert P. Goldman's avatar
Robert P. Goldman committed
20
(assert (not (asdf:find-system "test-asdf/force1" nil)))
21
(DBG "Correctly failed to find system.")
22
(defvar *attempts* 0)
23
(assert
24
 (with-asdf-session (:override t)
25 26 27 28 29 30 31 32 33 34 35 36 37 38
   (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)
39 40 41 42 43

(DBG "Refinding test successful.")

(DBG "Now trying LOAD-SYSTEM with refinding.")
(clear-caches-and-search)
44

45 46 47
(def-test-system test-missing-dependency
  :depends-on ("test-asdf/force1")
  :components ((:file "file2")))
48
(setf *attempts* 0)
49
(with-asdf-session (:override t)
50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81
  (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)