Commit 5a4a89f5 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Add tests for defsystem-depends-on

Attila offered these tests, that currently fail at HEAD,
for which I have a patch (to be included in next commit).
They check that an error when loading defsystem-depends-on dependencies
doesn't cause an incomplete system to be registered but never properly
parsed, that thereafter pollute the build.

A real solution would imply to fix lp#1500578 though:
   ASDF should handle change in defsystem-depends-on dependencies
   https://bugs.launchpad.net/asdf/+bug/1500578
parent 468790d7
...@@ -295,7 +295,8 @@ Going forward, we recommend new users should be using the source-registry. ...@@ -295,7 +295,8 @@ Going forward, we recommend new users should be using the source-registry.
(find-system (coerce-name name) error-p)) (find-system (coerce-name name) error-p))
(defun find-system-if-being-defined (name) (defun find-system-if-being-defined (name)
;; notable side effect: mark the system as being defined, to avoid infinite loops ;; NB: this depends on a corresponding side-effect in parse-defsystem;
;; this protocol may change somewhat in the future.
(first (gethash `(find-system ,(coerce-name name)) *asdf-cache*))) (first (gethash `(find-system ,(coerce-name name)) *asdf-cache*)))
(defun load-asd (pathname (defun load-asd (pathname
...@@ -316,10 +317,10 @@ Going forward, we recommend new users should be using the source-registry. ...@@ -316,10 +317,10 @@ Going forward, we recommend new users should be using the source-registry.
;; resolve logical-pathnames so they won't wreak havoc in parsing namestrings. ;; resolve logical-pathnames so they won't wreak havoc in parsing namestrings.
(pathname-directory-pathname (physicalize-pathname pathname)))) (pathname-directory-pathname (physicalize-pathname pathname))))
(handler-bind (handler-bind
((error #'(lambda (condition) (((and error (not missing-component))
(error 'load-system-definition-error #'(lambda (condition)
:name name :pathname pathname (error 'load-system-definition-error
:condition condition)))) :name name :pathname pathname :condition condition))))
(asdf-message (compatfmt "~&~@<; ~@;Loading system definition~@[ for ~A~] from ~A~@:>~%") (asdf-message (compatfmt "~&~@<; ~@;Loading system definition~@[ for ~A~] from ~A~@:>~%")
name pathname) name pathname)
(load* pathname :external-format external-format)))))) (load* pathname :external-format external-format))))))
......
...@@ -160,7 +160,7 @@ ...@@ -160,7 +160,7 @@
;;; Main parsing function ;;; Main parsing function
(with-upgradability () (with-upgradability ()
(defun* parse-dependency-def (dd) (defun parse-dependency-def (dd)
(if (listp dd) (if (listp dd)
(case (first dd) (case (first dd)
(:feature (:feature
...@@ -181,12 +181,12 @@ ...@@ -181,12 +181,12 @@
(otherwise (sysdef-error "Ill-formed dependency: ~s" dd))) (otherwise (sysdef-error "Ill-formed dependency: ~s" dd)))
(coerce-name dd))) (coerce-name dd)))
(defun* parse-dependency-defs (dd-list) (defun parse-dependency-defs (dd-list)
"Parse the dependency defs in DD-LIST into canonical form by translating all "Parse the dependency defs in DD-LIST into canonical form by translating all
system names contained using COERCE-NAME. Return the result." system names contained using COERCE-NAME. Return the result."
(mapcar 'parse-dependency-def dd-list)) (mapcar 'parse-dependency-def dd-list))
(defun* (parse-component-form) (parent options &key previous-serial-component) (defun (parse-component-form) (parent options &key previous-serial-component)
(destructuring-bind (destructuring-bind
(type name &rest rest &key (type name &rest rest &key
(builtin-system-p () bspp) (builtin-system-p () bspp)
...@@ -276,6 +276,15 @@ system names contained using COERCE-NAME. Return the result." ...@@ -276,6 +276,15 @@ system names contained using COERCE-NAME. Return the result."
(with-asdf-cache () (with-asdf-cache ()
(let* ((name (coerce-name name)) (let* ((name (coerce-name name))
(source-file (if sfp source-file (resolve-symlinks* (load-pathname)))) (source-file (if sfp source-file (resolve-symlinks* (load-pathname))))
;; NB: handle defsystem-depends-on BEFORE to create the system object,
;; so that in case it fails, there is no incomplete object polluting the build.
(checked-defsystem-depends-on
(let* ((dep-forms (parse-dependency-defs defsystem-depends-on))
(deps (loop :for spec :in dep-forms
:when (resolve-dependency-spec nil spec)
:collect :it)))
(load-systems* deps)
dep-forms))
(registered (system-registered-p name)) (registered (system-registered-p name))
(registered! (if registered (registered! (if registered
(rplaca registered (get-file-stamp source-file)) (rplaca registered (get-file-stamp source-file))
...@@ -284,17 +293,12 @@ system names contained using COERCE-NAME. Return the result." ...@@ -284,17 +293,12 @@ system names contained using COERCE-NAME. Return the result."
(system (reset-system (cdr registered!) (system (reset-system (cdr registered!)
:name name :source-file source-file)) :name name :source-file source-file))
(component-options (component-options
(remove-plist-keys '(:defsystem-depends-on :class) options)) (append
(defsystem-dependencies (loop :for spec :in defsystem-depends-on (remove-plist-keys '(:defsystem-depends-on :class) options)
:when (resolve-dependency-spec nil spec) ;; cache defsystem-depends-on in canonical form
:collect :it))) (when checked-defsystem-depends-on
;; cache defsystem-depends-on in canonical form `(:defsystem-depends-on ,checked-defsystem-depends-on)))))
(when defsystem-depends-on
(setf component-options
(append `(:defsystem-depends-on ,(parse-dependency-defs defsystem-depends-on))
component-options)))
(set-asdf-cache-entry `(find-system ,name) (list system)) (set-asdf-cache-entry `(find-system ,name) (list system))
(load-systems* defsystem-dependencies)
;; We change-class AFTER we loaded the defsystem-depends-on ;; We change-class AFTER we loaded the defsystem-depends-on
;; since the class might be defined as part of those. ;; since the class might be defined as part of those.
(let ((class (class-for-type nil class))) (let ((class (class-for-type nil class)))
......
;;; -*- Lisp -*-
(defsystem test-defsystem-depends-on-missing-system
:defsystem-depends-on (nonexistent-system))
...@@ -38,3 +38,12 @@ ...@@ -38,3 +38,12 @@
:defsystem-depends-on ((:feature ,*newsym* "test-defsystem-depends-on-3")))) :defsystem-depends-on ((:feature ,*newsym* "test-defsystem-depends-on-3"))))
(assert (find-system "test-defsystem-depends-on-4")) (assert (find-system "test-defsystem-depends-on-4"))
(progn
(signals asdf:missing-dependency (def-test-system unloadable-system
:defsystem-depends-on (nonexistent-system)))
(assert (not (system-registered-p "unloadable-system"))))
(progn
(signals asdf:missing-dependency (find-system "test-defsystem-depends-on-missing-system"))
(assert (not (system-registered-p "test-defsystem-depends-on-missing-system"))))
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