test-try-refinding.script 3.14 KB
Newer Older
Robert P. Goldman's avatar
Robert P. Goldman committed
1 2 3 4
;;; -*- Lisp -*-

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

5
(setf *asdf-session* nil)
Robert P. Goldman's avatar
Robert P. Goldman committed
6 7 8 9 10 11 12 13

(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"))

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

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

(DBG "Refinding test successful.")

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

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