Commit 7c3f979c authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

operate: replace *systems-being-operated* by *in-operate*

parent 22d4c162
...@@ -8,7 +8,6 @@ ...@@ -8,7 +8,6 @@
:asdf/find-system :asdf/find-component :asdf/lisp-action :asdf/plan) :asdf/find-system :asdf/find-component :asdf/lisp-action :asdf/plan)
(:export (:export
#:operate #:oos #:operate #:oos
#:*systems-being-operated*
#:build-op #:make #:build-op #:make
#:load-system #:load-systems #:load-systems* #:load-system #:load-systems #:load-systems*
#:compile-system #:test-system #:require-system #:compile-system #:test-system #:require-system
...@@ -50,10 +49,8 @@ But do NOT depend on it, for this is deprecated behavior.")) ...@@ -50,10 +49,8 @@ But do NOT depend on it, for this is deprecated behavior."))
:operation-initargs t ;; backward-compatibility with ASDF1. Deprecated. :operation-initargs t ;; backward-compatibility with ASDF1. Deprecated.
:if-no-component (error 'missing-component :requires component)) :if-no-component (error 'missing-component :requires component))
;; TODO: actually, the use as a hash-set is write-only, so it can be reduced to a boolean, (defvar *in-operate* nil
;; and then possibly replaced by checking for say *asdf-cache*. "Are we in operate?")
(defvar *systems-being-operated* nil
"A hash-set of names of systems being operated on, or NIL")
;; This method ensures that an ASDF upgrade is attempted as the very first thing, ;; This method ensures that an ASDF upgrade is attempted as the very first thing,
;; with suitable state preservation in case in case it actually happens, ;; with suitable state preservation in case in case it actually happens,
...@@ -62,36 +59,36 @@ But do NOT depend on it, for this is deprecated behavior.")) ...@@ -62,36 +59,36 @@ But do NOT depend on it, for this is deprecated behavior."))
&key verbose &key verbose
(on-warnings *compile-file-warnings-behaviour*) (on-warnings *compile-file-warnings-behaviour*)
(on-failure *compile-file-failure-behaviour*) &allow-other-keys) (on-failure *compile-file-failure-behaviour*) &allow-other-keys)
(let* ((systems-being-operated *systems-being-operated*) (nest
(*systems-being-operated* (or systems-being-operated (make-hash-table :test 'equal))) (with-asdf-cache ())
(let ((in-operate *in-operate*)
(*in-operate* t)
(operation-remaker ;; how to remake the operation after ASDF was upgraded (if it was) (operation-remaker ;; how to remake the operation after ASDF was upgraded (if it was)
(etypecase operation (etypecase operation
(operation (let ((name (type-of operation)) (operation (let ((name (type-of operation))
(initargs (operation-original-initargs operation))) (initargs (operation-original-initargs operation)))
#'(lambda () (apply 'make-operation name :original-initargs initargs initargs)))) #'(lambda () (apply 'make-operation name :original-initargs initargs initargs))))
((or symbol string) (constantly operation)))) ((or symbol string) (constantly operation))))
(component-path (typecase component ;; to remake the component after ASDF upgrade (component-path (typecase component ;; to remake the component after ASDF upgrade
(component (component-find-path component)) (component (component-find-path component))
(t component)))) (t component)))))
;; Before we operate on any system, make sure ASDF is up-to-date, ;; Before we operate on any system, make sure ASDF is up-to-date,
;; for if an upgrade is ever attempted at any later time, there may be BIG trouble. ;; for if an upgrade is ever attempted at any later time, there may be BIG trouble.
(unless systems-being-operated (progn
(when (upgrade-asdf) (unless in-operate
;; If we were upgraded, restart OPERATE the hardest of ways, for (when (upgrade-asdf)
;; its function may have been redefined, its symbol uninterned, its package deleted. ;; If we were upgraded, restart OPERATE the hardest of ways, for
(return-from operate ;; its function may have been redefined, its symbol uninterned, its package deleted.
(apply 'operate (funcall operation-remaker) component-path keys)))) (return-from operate
(apply 'operate (funcall operation-remaker) component-path keys)))))
;; Setup proper bindings around any operate call. ;; Setup proper bindings around any operate call.
(with-asdf-cache () (let* ((*verbose-out* (and verbose *standard-output*))
(let* ((*verbose-out* (and verbose *standard-output*)) (*compile-file-warnings-behaviour* on-warnings)
(*compile-file-warnings-behaviour* on-warnings) (*compile-file-failure-behaviour* on-failure))
(*compile-file-failure-behaviour* on-failure)) (call-next-method))))
(call-next-method)))))
(defmethod operate :before ((operation operation) (component component) (defmethod operate :before ((operation operation) (component component)
&key version &allow-other-keys) &key version &allow-other-keys)
(let ((system (component-system component)))
(setf (gethash (coerce-name system) *systems-being-operated*) system))
(unless (version-satisfies component version) (unless (version-satisfies component version)
(error 'missing-component-of-version :requires component :version version))) (error 'missing-component-of-version :requires component :version version)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment