Loading find-system.lisp +50 −55 Original line number Diff line number Diff line Loading @@ -21,11 +21,11 @@ #:clear-defined-system #:clear-defined-systems #:*defined-systems* #:*immutable-systems* ;; defined in source-registry, but specially mentioned here: #:sysdef-source-registry-search )) #:initialize-source-registry #: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 @@ -382,12 +382,13 @@ 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)))) (defun find-system-1 (name) (defmethod find-system ((name string) &optional (error-p t)) (with-asdf-cache (:key `(find-system ,name)) (let ((primary-name (primary-system-name name))) (unless (equal name primary-name) (find-system primary-name nil))) (prog () (loop (restart-case (multiple-value-bind (foundp found-system pathname previous previous-time) (locate-system name) (when (and found-system (eq found-system previous) Loading Loading @@ -415,25 +416,19 @@ 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 (when in-memory (cond (in-memory (when pathname (setf (car in-memory) (get-file-stamp pathname))) (cdr in-memory)))))))) (defmethod find-system ((name string) &optional (error-p t)) (restart-case (let ((ret (find-system-1 name))) (cond (ret ret) (cdr in-memory)) (error-p (error 'missing-component :requires name)) (t nil))) (t ;; not found: don't keep negative cache (unset-asdf-cache-entry `(locate-system ,name)) (return-from find-system nil)))))) (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) (find-system name error-p))))) (format s (compatfmt "~@<Retry finding system ~A after reinitializing the source-registry.~@:>") name)) (unset-asdf-cache-entry `(locate-system ,name)) (initialize-source-registry))))))) Loading
find-system.lisp +50 −55 Original line number Diff line number Diff line Loading @@ -21,11 +21,11 @@ #:clear-defined-system #:clear-defined-systems #:*defined-systems* #:*immutable-systems* ;; defined in source-registry, but specially mentioned here: #:sysdef-source-registry-search )) #:initialize-source-registry #: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 @@ -382,12 +382,13 @@ 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)))) (defun find-system-1 (name) (defmethod find-system ((name string) &optional (error-p t)) (with-asdf-cache (:key `(find-system ,name)) (let ((primary-name (primary-system-name name))) (unless (equal name primary-name) (find-system primary-name nil))) (prog () (loop (restart-case (multiple-value-bind (foundp found-system pathname previous previous-time) (locate-system name) (when (and found-system (eq found-system previous) Loading Loading @@ -415,25 +416,19 @@ 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 (when in-memory (cond (in-memory (when pathname (setf (car in-memory) (get-file-stamp pathname))) (cdr in-memory)))))))) (defmethod find-system ((name string) &optional (error-p t)) (restart-case (let ((ret (find-system-1 name))) (cond (ret ret) (cdr in-memory)) (error-p (error 'missing-component :requires name)) (t nil))) (t ;; not found: don't keep negative cache (unset-asdf-cache-entry `(locate-system ,name)) (return-from find-system nil)))))) (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) (find-system name error-p))))) (format s (compatfmt "~@<Retry finding system ~A after reinitializing the source-registry.~@:>") name)) (unset-asdf-cache-entry `(locate-system ,name)) (initialize-source-registry)))))))