/usr/share/doc/cl-asdf/examples/test-try-refinding.script is in cl-asdf 2:3.1.6-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 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 82 83 | ;;; -*- 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"))
(defun clear-caches-and-search ()
(setf asdf:*central-registry* nil)
(clear-system "test-asdf")
(clear-system "test-asdf/force1"))
(DBG "Clearing the caches and finding.")
(clear-caches-and-search)
(assert (not (asdf:find-system "test-asdf/force1" nil)))
(DBG "Correctly failed to find system.")
(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)))))
(DBG "Refinding test successful.")
(DBG "Now trying LOAD-SYSTEM with refinding.")
(clear-caches-and-search)
(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)
(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")))))
|