Commit f6c5f6f4 authored by Matthew Steele's avatar Matthew Steele

Added a test case for detection of *features* dependencies.

parent c586c88e
...@@ -184,18 +184,16 @@ keeping declarations intact." ...@@ -184,18 +184,16 @@ keeping declarations intact."
(parse-body body :ignore-multiple-docstrings nil) (parse-body body :ignore-multiple-docstrings nil)
`(,@decls ,doc ,form ,@(or body (list nil))))) `(,@decls ,doc ,form ,@(or body (list nil)))))
;; Used only by call-with-dependency-tracking in asdf-ops.lisp.
(defmacro noticing-*feature*-changes (&rest body) (defmacro noticing-*feature*-changes (&rest body)
;; naive implementation, doesn't really deal with removed features ;; naive implementation, doesn't really deal with removed features
(let ((old-features (gensym)) (with-gensyms (old-features feature)
(new-feature (gensym))
(removed-feature (gensym)))
`(let ((,old-features (copy-list *features*))) `(let ((,old-features (copy-list *features*)))
(prog1 (progn ,@body) (multiple-value-prog1
(dolist (,new-feature (set-difference *features* ,old-features)) (progn ,@body)
(signal-provider ,new-feature 'feature)) (dolist (,feature (set-difference *features* ,old-features))
(dolist (,removed-feature (set-difference ,old-features *features*)) (signal-provider ,feature 'feature))
(signal-provider ,removed-feature 'removed-feature)))))) (dolist (,feature (set-difference ,old-features *features*))
(signal-provider ,feature 'removed-feature))))))
(labels ((signal-feature (presentp feature) (labels ((signal-feature (presentp feature)
(signal-user feature (signal-user feature
...@@ -278,7 +276,7 @@ keeping declarations intact." ...@@ -278,7 +276,7 @@ keeping declarations intact."
,new-macro-body ,env)) ,new-macro-body ,env))
,@,epilogue))) ,@,epilogue)))
;; Used by instrumenting-macroexpand-hook, and also exported (not sure why). ;; Used only by instrumenting-macroexpand-hook.
(defun handle-macroexpansion (name form function environment) (defun handle-macroexpansion (name form function environment)
"Handle macroexpansion of a macro called `name' on `form' with macro function "Handle macroexpansion of a macro called `name' on `form' with macro function
`function' in `environment'. Either dispatch to the appropriate handler, or `function' in `environment'. Either dispatch to the appropriate handler, or
...@@ -657,7 +655,7 @@ keeping declarations intact." ...@@ -657,7 +655,7 @@ keeping declarations intact."
:component ,component!))))) :component ,component!)))))
(*current-constituent* ,con)) (*current-constituent* ,con))
(assert (equal (constituent-designator ,con) ,designator)) (assert (equal (constituent-designator ,con) ,designator))
(progn ,@body)))) (noticing-*feature*-changes ,@body))))
(defmacro operating-on-file-constituent ((path) &body body) (defmacro operating-on-file-constituent ((path) &body body)
"Used internally; not exported." "Used internally; not exported."
...@@ -676,7 +674,7 @@ keeping declarations intact." ...@@ -676,7 +674,7 @@ keeping declarations intact."
(*previous-package* *package*)) ;; See Note [prev-package] below (*previous-package* *package*)) ;; See Note [prev-package] below
(assert (equal (constituent-designator ,con) ,designator)) (assert (equal (constituent-designator ,con) ,designator))
(multiple-value-prog1 (multiple-value-prog1
(progn ,@body) (noticing-*feature*-changes ,@body)
(signal-new-internal-symbols :populate t))))) (signal-new-internal-symbols :populate t)))))
;; Note [prev-package]: Notice that operating-on-file-constituent binds ;; Note [prev-package]: Notice that operating-on-file-constituent binds
...@@ -706,7 +704,7 @@ keeping declarations intact." ...@@ -706,7 +704,7 @@ keeping declarations intact."
(*current-constituent* ,con)) (*current-constituent* ,con))
(assert (equal (constituent-designator ,con) ,designator)) (assert (equal (constituent-designator ,con) ,designator))
(multiple-value-prog1 (multiple-value-prog1
(progn ,@body) (noticing-*feature*-changes ,@body)
(signal-new-internal-symbols :populate t))))) (signal-new-internal-symbols :populate t)))))
;;;;;;;;;;;;;;;;;;;;;;;; Initially Grovel Dependencies ;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;; Initially Grovel Dependencies ;;;;;;;;;;;;;;;;;;;;;;;;
...@@ -765,7 +763,7 @@ keeping declarations intact." ...@@ -765,7 +763,7 @@ keeping declarations intact."
(let ((constituent-deps (constituent-dependency-table top)) (let ((constituent-deps (constituent-dependency-table top))
(component-deps (make-hash-table :test 'eql)) (component-deps (make-hash-table :test 'eql))
(system-deps (make-hash-table :test 'eql))) (system-deps (make-hash-table :test 'eql)))
;; Build dependency tables. ;; Populate the component-deps and system-deps tables.
(loop :for con1 :being :each :hash-key :of constituent-deps (loop :for con1 :being :each :hash-key :of constituent-deps
:using (:hash-value deps) :using (:hash-value deps)
:when (typep con1 'asdf-component-constituent) :do :when (typep con1 'asdf-component-constituent) :do
...@@ -777,7 +775,7 @@ keeping declarations intact." ...@@ -777,7 +775,7 @@ keeping declarations intact."
(pushnew (asdf:component-system comp2) (pushnew (asdf:component-system comp2)
(gethash (asdf:component-system comp1) system-deps) (gethash (asdf:component-system comp1) system-deps)
:test 'eql))))) :test 'eql)))))
;; Build and return dependency forms. ;; Build and return the dependency forms.
(loop :for system :in interesting-systems (loop :for system :in interesting-systems
:collect `(,system :collect `(,system
:depends-on ,(gethash system system-deps) :depends-on ,(gethash system system-deps)
......
...@@ -12,7 +12,7 @@ ...@@ -12,7 +12,7 @@
#:additional-initargs #:additional-initargs
#:read-component-file #:read-component-file
#:systems-in-configuration #:systems-in-configuration
#:handle-macroexpansion ;;#:handle-macroexpansion
#:define-macroexpand-handlers #:define-macroexpand-handlers
#:signal-user #:signal-user
#:signal-provider #:signal-provider
......
(cl:in-package :asdf-dependency-grovel-test)
(pushnew :it-is-not-a-bug *features*)
...@@ -2,11 +2,12 @@ ...@@ -2,11 +2,12 @@
(asdf:defsystem :test-serial-system (asdf:defsystem :test-serial-system
:serial t :serial t
:components ( :components ((:file "package")
(:file "package")
;; simple stuff ;; simple stuff
(:file "p-defmacro") (:file "p-defmacro")
(:file "p-define-method-combination") (:file "p-define-method-combination")
(:file "p-feature")
;; setf ;; setf
(:file "p-define-setf-expander") (:file "p-define-setf-expander")
...@@ -36,6 +37,7 @@ ...@@ -36,6 +37,7 @@
(:file "u-defmacro") (:file "u-defmacro")
(:file "u-defmacro.indirect") (:file "u-defmacro.indirect")
(:file "u-define-method-combination") (:file "u-define-method-combination")
(:file "u-feature")
;; setf ;; setf
(:file "u-define-setf-expander") (:file "u-define-setf-expander")
......
(cl:in-package :asdf-dependency-grovel-test)
(defvar *is-it-a-feature* (or nil #+it-is-not-a-bug t))
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