Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
asdf
asdf
Commits
2301a5e9
Commit
2301a5e9
authored
Jul 10, 2014
by
Francois-Rene Rideau
Browse files
Another take on bug1335323
parent
fe907bbd
Changes
6
Hide whitespace changes
Inline
Side-by-side
cache.lisp
View file @
2301a5e9
...
...
@@ -7,11 +7,7 @@
#:set-asdf-cache-entry
#:unset-asdf-cache-entry
#:consult-asdf-cache
#:do-asdf-cache
#:normalize-namestring
#:call-with-asdf-cache
#:with-asdf-cache
#:*asdf-cache*
#:clear-asdf-cache
#:reinitialize-source-registry-and-retry
;; defined in source-registry, but specially mentioned here:
#:initialize-source-registry
))
#:clear-configuration-and-retry
#:retry
))
(
in-package
:asdf/cache
)
;;; This stamp cache is useful for:
...
...
@@ -20,8 +16,6 @@
;; * the ability to test with fake timestamps, without touching files
(
with-upgradability
()
(
declaim
(
ftype
(
function
(
&optional
t
)
t
)
initialize-source-registry
))
; forward reference
(
defvar
*asdf-cache*
nil
)
(
defun
set-asdf-cache-entry
(
key
value-list
)
...
...
@@ -30,10 +24,6 @@
(
setf
(
gethash
key
*asdf-cache*
)
value-list
)
value-list
)))
(
defun
clear-asdf-cache
()
(
when
*asdf-cache*
(
setf
*asdf-cache*
(
clrhash
*asdf-cache*
))))
(
defun
unset-asdf-cache-entry
(
key
)
(
when
*asdf-cache*
(
remhash
key
*asdf-cache*
)))
...
...
@@ -53,21 +43,17 @@
(
let
((
fun
(
if
key
#'
(
lambda
()
(
consult-asdf-cache
key
thunk
))
thunk
)))
(
if
(
and
*asdf-cache*
(
not
override
))
(
funcall
fun
)
(
flet
((
establish-cache-and-call
()
(
let
((
*asdf-cache*
(
make-hash-table
:test
'equal
)))
(
funcall
fun
))))
(
loop
(
restart-case
(
establish-cache-and-call
)
(
reinitialize-source-registry-and-retry
()
(
let
((
*asdf-cache*
(
make-hash-table
:test
'equal
)))
(
return
(
funcall
fun
)))
(
retry
()
:report
(
lambda
(
s
)
(
format
s
(
compatfmt
"~@<Retry ASDF operation.~@:>"
))))
(
clear-configuration-and-retry
()
:report
(
lambda
(
s
)
(
format
s
(
compatfmt
"~@<Retry ASDF operation after reinitializing the source-registry.~@:>"
)))
;; since you're reinitializing the source registry, an arbitrary
;; amount of the ASDF cache is invalidated, not just the entry
;; for the current NAME.
(
clear-asdf-cache
)
;; (unset-asdf-cache-entry `(locate-system ,name))
(
initialize-source-registry
)
(
establish-cache-and-call
)))))))
(
format
s
(
compatfmt
"~@<Retry ASDF operation after resetting the configuration.~@:>"
)))
(
clear-configuration
)))))))
(
defmacro
with-asdf-cache
((
&key
key
override
)
&body
body
)
`
(
call-with-asdf-cache
#'
(
lambda
()
,@
body
)
:override
,
override
:key
,
key
))
...
...
find-system.lisp
View file @
2301a5e9
...
...
@@ -423,12 +423,6 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
(
cdr
in-memory
))
(
error-p
(
error
'missing-component
:requires
name
))
(
t
;; not found: don't keep negative cache
(
t
;; not found: don't keep negative cache
, see lp#1335323
(
unset-asdf-cache-entry
`
(
locate-system
,
name
))
(
return-from
find-system
nil
))))))
(
reinitialize-source-registry-and-retry
()
:report
(
lambda
(
s
)
(
format
s
(
compatfmt
"~@<Retry finding system ~A after reinitializing the source-registry.~@:>"
)
name
))
(
unset-asdf-cache-entry
`
(
locate-system
,
name
))
(
initialize-source-registry
)))))))
(
return-from
find-system
nil
)))))))))))
interface.lisp
View file @
2301a5e9
...
...
@@ -126,12 +126,12 @@
#:package-inferred-system-missing-package-error
#:operation-definition-warning
#:operation-definition-error
#:try-recompiling
#:try-recompiling
; restarts
#:retry
#:accept
; restarts
#:accept
#:coerce-entry-to-directory
#:remove-entry-from-registry
#:
reinitialize-source-registry
-and-retry
#:
clear-configuration
-and-retry
#:*encoding-detection-hook*
...
...
@@ -169,6 +169,5 @@
#:system-source-registry
#:user-source-registry-directory
#:system-source-registry-directory
#:clear-asdf-cache
))
source-registry.lisp
View file @
2301a5e9
...
...
@@ -5,7 +5,6 @@
(
uiop/package:define-package
:asdf/source-registry
(
:recycle
:asdf/source-registry
:asdf
)
(
:use
:uiop/common-lisp
:uiop
:asdf/upgrade
:asdf/find-system
)
(
:import-from
:asdf/cache
#:initialize-source-registry
)
(
:export
#:*source-registry-parameter*
#:*default-source-registries*
#:invalid-source-registry
...
...
test/test-try-refinding.script
View file @
2301a5e9
...
...
@@ -12,6 +12,7 @@
(defun clear-caches-and-search ()
(setf asdf:*central-registry* nil)
(asdf/find-system:clear-defined-system "test-asdf")
(asdf/find-system:clear-defined-system "test-asdf/force1"))
(DBG "Clearing the caches and finding.")
...
...
@@ -20,25 +21,26 @@
(DBG "Correctly failed to find system.")
(assert
(let (tried-once)
(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:reinitialize-source
-registry
-an
d-retry)
)
;; avoid infinite looping
(error c)))))
(asdf:find-system "test-asdf/force1" t))))
(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
* *ol
d-re
gis
try
*
)
(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")))
...
...
@@ -47,34 +49,35 @@
;; (trace asdf::component-find-path)
;; (trace operate)
(let (tried-once)
(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:reinitialize-source-registry-and-retry)
(error "Expected REINITIALIZE-SOURCE-REGISTRY-AND-RETRY restart not found."))
(DBG "Before invoking restart, CENTRAL-REGISTRY is:"
asdf:*central-registry*)
(invoke-restart 'asdf:reinitialize-source-registry-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"))))
(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")))))
test/test-utilities.script
View file @
2301a5e9
...
...
@@ -161,7 +161,7 @@
asdf/find-system:contrib-sysdef-search
asdf/find-system:sysdef-find-asdf
;; restart
asdf/cache:
reinitialize-source-registry
-and-retry
asdf/cache:
clear-configuration
-and-retry
))
(defun defined-symbol-p (symbol)
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment