test-try-refinding.script 3.21 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 25 26 27 28 29 30 31 32 33 34 35 36 37 38
 (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)
39 40 41 42 43

(DBG "Refinding test successful.")

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

45 46 47 48 49 50 51
(def-test-system test-missing-dependency
  :depends-on ("test-asdf/force1")
  :components ((:file "file2")))
;; (trace find-system)
;; (trace find-component)
;; (trace asdf::component-find-path)
;; (trace operate)
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 82 83 84 85
(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)