Skip to content
Snippets Groups Projects
Commit bcfbac2f authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

More backward compatible REQUIRE behavior

Don't warn when OPERATE is called by REQUIRE.

Don't use :FORCE-NOT in REQUIRE-SYSTEM (only check that
the required system isn't present yet; otherwise inherit ambient force-not).
parent 10f329e5
No related branches found
No related tags found
No related merge requests found
...@@ -61,9 +61,8 @@ ...@@ -61,9 +61,8 @@
(push (cons operation component) (definition-dependency-list parent-component)) (push (cons operation component) (definition-dependency-list parent-component))
(setf (gethash action (definition-dependency-set parent-component)) t)))) (setf (gethash action (definition-dependency-set parent-component)) t))))
(t (t
(warn (compatfmt "~@<Deprecated recursive use of (~S '~S '~S) while visiting ~S ~ (warn 'recursive-operate
- please use proper dependencies instead~@:>") :operation operation :component component :action action)))))))
'operate (type-of operation) (component-find-path component) (action-path action))))))))
(defmethod component-depends-on ((o define-op) (s system)) (defmethod component-depends-on ((o define-op) (s system))
`(;;NB: 1- ,@(system-defsystem-depends-on s)) ; Should be already included in the below. `(;;NB: 1- ,@(system-defsystem-depends-on s)) ; Should be already included in the below.
......
...@@ -10,7 +10,8 @@ ...@@ -10,7 +10,8 @@
#:operate #:oos #:build-op #:make #:operate #:oos #:build-op #:make
#:load-system #:load-systems #:load-systems* #:load-system #:load-systems #:load-systems*
#:compile-system #:test-system #:require-system #:module-provide-asdf #:compile-system #:test-system #:require-system #:module-provide-asdf
#:component-loaded-p #:already-loaded-systems)) #:component-loaded-p #:already-loaded-systems
#:recursive-operate))
(in-package :asdf/operate) (in-package :asdf/operate)
(with-upgradability () (with-upgradability ()
...@@ -106,8 +107,19 @@ But do NOT depend on it, for this is deprecated behavior.")) ...@@ -106,8 +107,19 @@ But do NOT depend on it, for this is deprecated behavior."))
(setf (documentation 'oos 'function) (setf (documentation 'oos 'function)
(format nil "Short for _operate on system_ and an alias for the OPERATE function.~%~%~a" (format nil "Short for _operate on system_ and an alias for the OPERATE function.~%~%~a"
(documentation 'operate 'function)))) (documentation 'operate 'function)))
(define-condition recursive-operate (warning)
((operation :initarg :operation :reader condition-operation)
(component :initarg :component :reader condition-component)
(action :initarg :action :reader condition-action))
(:report (lambda (c s)
(format s (compatfmt "~@<Deprecated recursive use of (~S '~S '~S) while visiting ~S ~
- please use proper dependencies instead~@:>")
'operate
(type-of (condition-operation c))
(component-find-path (condition-component c))
(action-path (condition-action c)))))))
;;;; Common operations ;;;; Common operations
(when-upgrading () (when-upgrading ()
...@@ -175,9 +187,10 @@ Note that this returns true even if the component is not up to date." ...@@ -175,9 +187,10 @@ Note that this returns true even if the component is not up to date."
(defun require-system (system &rest keys &key &allow-other-keys) (defun require-system (system &rest keys &key &allow-other-keys)
"Ensure the specified SYSTEM is loaded, passing the KEYS to OPERATE, but do not update the "Ensure the specified SYSTEM is loaded, passing the KEYS to OPERATE, but do not update the
system or its dependencies if they have already been loaded." system or its dependencies if it has already been loaded."
(declare (ignore keys))
(unless (component-loaded-p system) (unless (component-loaded-p system)
(apply 'load-system system :force-not (already-loaded-systems) keys)))) (load-system system))))
;;;; Define the class REQUIRE-SYSTEM, to be hooked into CL:REQUIRE when possible, ;;;; Define the class REQUIRE-SYSTEM, to be hooked into CL:REQUIRE when possible,
...@@ -236,7 +249,7 @@ the implementation's REQUIRE rather than by internal ASDF mechanisms.")) ...@@ -236,7 +249,7 @@ the implementation's REQUIRE rather than by internal ASDF mechanisms."))
(let ((*modules-being-required* (cons module-name *modules-being-required*)) (let ((*modules-being-required* (cons module-name *modules-being-required*))
#+sbcl (sb-impl::*requiring* (remove module-name sb-impl::*requiring* :test 'equal))) #+sbcl (sb-impl::*requiring* (remove module-name sb-impl::*requiring* :test 'equal)))
(handler-bind (handler-bind
((style-warning #'muffle-warning) (((or style-warning recursive-operate) #'muffle-warning)
(missing-component (constantly nil)) (missing-component (constantly nil))
(fatal-condition (fatal-condition
#'(lambda (e) #'(lambda (e)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment