Loading cache.lisp +23 −4 Original line number Diff line number Diff line Loading @@ -7,7 +7,11 @@ #: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)) #:clear-asdf-cache #:reinitialize-source-registry-and-retry ;; defined in source-registry, but specially mentioned here: #:initialize-source-registry )) (in-package :asdf/cache) ;;; This stamp cache is useful for: Loading @@ -16,6 +20,8 @@ ;; * 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) Loading @@ -26,7 +32,7 @@ (defun clear-asdf-cache () (when *asdf-cache* (setf *asdf-cache* (make-hash-table :test 'equal)))) (setf *asdf-cache* (clrhash *asdf-cache*)))) (defun unset-asdf-cache-entry (key) (when *asdf-cache* Loading @@ -47,8 +53,21 @@ (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))))) (funcall fun)))) (restart-case (establish-cache-and-call) (reinitialize-source-registry-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))))))) (defmacro with-asdf-cache ((&key key override) &body body) `(call-with-asdf-cache #'(lambda () ,@body) :override ,override :key ,key)) Loading find-system.lisp +54 −53 Original line number Diff line number Diff line Loading @@ -21,13 +21,11 @@ #:clear-defined-system #:clear-defined-systems #:*defined-systems* #:*immutable-systems* ;; defined in source-registry, but specially mentioned here: #:initialize-source-registry #:sysdef-source-registry-search #:reinitialize-source-registry-and-retry #:sysdef-source-registry-search )) (in-package :asdf/find-system) (with-upgradability () (declaim (ftype (function (&optional t) t) initialize-source-registry)) ; forward reference (define-condition missing-component (system-definition-error) ((requires :initform "(unnamed)" :reader missing-requires :initarg :requires) Loading Loading @@ -384,13 +382,12 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. (setf found-system found pathname nil)))) (values foundp found-system pathname previous previous-time)))) (defmethod find-system ((name string) &optional (error-p t)) (defun find-system-1 (name) (with-asdf-cache (:key `(find-system ,name)) (let ((primary-name (primary-system-name name))) (unless (equal name primary-name) (find-system primary-name nil))) (loop (restart-case (prog () (multiple-value-bind (foundp found-system pathname previous previous-time) (locate-system name) (when (and found-system (eq found-system previous) Loading Loading @@ -418,21 +415,25 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. (load-asd pathname :name name))) (let ((in-memory (system-registered-p name))) ; try again after loading from disk if needed (return (cond (in-memory (when in-memory (when pathname (setf (car in-memory) (get-file-stamp pathname))) (cdr in-memory)) (cdr in-memory)))))))) (defmethod find-system ((name string) &optional (error-p t)) (restart-case (let ((ret (find-system-1 name))) (cond (ret ret) (error-p (error 'missing-component :requires name)))))) (error 'missing-component :requires name)) (t nil))) (reinitialize-source-registry-and-retry () :report (lambda (s) (format s (compatfmt "~@<Retry finding system ~A after reinitializing the source-registry.~@:>") name)) (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) (find-system name error-p))))))) (find-system name error-p))))) source-registry.lisp +1 −0 Original line number Diff line number Diff line Loading @@ -5,6 +5,7 @@ (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 Loading test/test-utilities.script +2 −0 Original line number Diff line number Diff line Loading @@ -160,6 +160,8 @@ asdf/backward-interface:on-warnings asdf/find-system:contrib-sysdef-search asdf/find-system:sysdef-find-asdf ;; restart asdf/cache:reinitialize-source-registry-and-retry )) (defun defined-symbol-p (symbol) Loading Loading
cache.lisp +23 −4 Original line number Diff line number Diff line Loading @@ -7,7 +7,11 @@ #: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)) #:clear-asdf-cache #:reinitialize-source-registry-and-retry ;; defined in source-registry, but specially mentioned here: #:initialize-source-registry )) (in-package :asdf/cache) ;;; This stamp cache is useful for: Loading @@ -16,6 +20,8 @@ ;; * 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) Loading @@ -26,7 +32,7 @@ (defun clear-asdf-cache () (when *asdf-cache* (setf *asdf-cache* (make-hash-table :test 'equal)))) (setf *asdf-cache* (clrhash *asdf-cache*)))) (defun unset-asdf-cache-entry (key) (when *asdf-cache* Loading @@ -47,8 +53,21 @@ (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))))) (funcall fun)))) (restart-case (establish-cache-and-call) (reinitialize-source-registry-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))))))) (defmacro with-asdf-cache ((&key key override) &body body) `(call-with-asdf-cache #'(lambda () ,@body) :override ,override :key ,key)) Loading
find-system.lisp +54 −53 Original line number Diff line number Diff line Loading @@ -21,13 +21,11 @@ #:clear-defined-system #:clear-defined-systems #:*defined-systems* #:*immutable-systems* ;; defined in source-registry, but specially mentioned here: #:initialize-source-registry #:sysdef-source-registry-search #:reinitialize-source-registry-and-retry #:sysdef-source-registry-search )) (in-package :asdf/find-system) (with-upgradability () (declaim (ftype (function (&optional t) t) initialize-source-registry)) ; forward reference (define-condition missing-component (system-definition-error) ((requires :initform "(unnamed)" :reader missing-requires :initarg :requires) Loading Loading @@ -384,13 +382,12 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. (setf found-system found pathname nil)))) (values foundp found-system pathname previous previous-time)))) (defmethod find-system ((name string) &optional (error-p t)) (defun find-system-1 (name) (with-asdf-cache (:key `(find-system ,name)) (let ((primary-name (primary-system-name name))) (unless (equal name primary-name) (find-system primary-name nil))) (loop (restart-case (prog () (multiple-value-bind (foundp found-system pathname previous previous-time) (locate-system name) (when (and found-system (eq found-system previous) Loading Loading @@ -418,21 +415,25 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. (load-asd pathname :name name))) (let ((in-memory (system-registered-p name))) ; try again after loading from disk if needed (return (cond (in-memory (when in-memory (when pathname (setf (car in-memory) (get-file-stamp pathname))) (cdr in-memory)) (cdr in-memory)))))))) (defmethod find-system ((name string) &optional (error-p t)) (restart-case (let ((ret (find-system-1 name))) (cond (ret ret) (error-p (error 'missing-component :requires name)))))) (error 'missing-component :requires name)) (t nil))) (reinitialize-source-registry-and-retry () :report (lambda (s) (format s (compatfmt "~@<Retry finding system ~A after reinitializing the source-registry.~@:>") name)) (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) (find-system name error-p))))))) (find-system name error-p)))))
source-registry.lisp +1 −0 Original line number Diff line number Diff line Loading @@ -5,6 +5,7 @@ (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 Loading
test/test-utilities.script +2 −0 Original line number Diff line number Diff line Loading @@ -160,6 +160,8 @@ asdf/backward-interface:on-warnings asdf/find-system:contrib-sysdef-search asdf/find-system:sysdef-find-asdf ;; restart asdf/cache:reinitialize-source-registry-and-retry )) (defun defined-symbol-p (symbol) Loading