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.
(find-system (coerce-name name) error-p))
(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*)))
(defun load-asd (pathname
......@@ -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.
(pathname-directory-pathname (physicalize-pathname pathname))))
(handler-bind
((error #'(lambda (condition)
(error 'load-system-definition-error
:name name :pathname pathname
:condition condition))))
(((and error (not missing-component))
#'(lambda (condition)
(error 'load-system-definition-error
:name name :pathname pathname :condition condition))))
(asdf-message (compatfmt "~&~@<; ~@;Loading system definition~@[ for ~A~] from ~A~@:>~%")
name pathname)
(load* pathname :external-format external-format))))))
......
......@@ -160,7 +160,7 @@
;;; Main parsing function
(with-upgradability ()
(defun* parse-dependency-def (dd)
(defun parse-dependency-def (dd)
(if (listp dd)
(case (first dd)
(:feature
......@@ -181,12 +181,12 @@
(otherwise (sysdef-error "Ill-formed dependency: ~s" 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
system names contained using COERCE-NAME. Return the result."
(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
(type name &rest rest &key
(builtin-system-p () bspp)
......@@ -276,6 +276,15 @@ system names contained using COERCE-NAME. Return the result."
(with-asdf-cache ()
(let* ((name (coerce-name name))
(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! (if registered
(rplaca registered (get-file-stamp source-file))
......@@ -284,17 +293,12 @@ system names contained using COERCE-NAME. Return the result."
(system (reset-system (cdr registered!)
:name name :source-file source-file))
(component-options
(remove-plist-keys '(:defsystem-depends-on :class) options))
(defsystem-dependencies (loop :for spec :in defsystem-depends-on
:when (resolve-dependency-spec nil spec)
:collect :it)))
;; cache defsystem-depends-on in canonical form
(when defsystem-depends-on
(setf component-options
(append `(:defsystem-depends-on ,(parse-dependency-defs defsystem-depends-on))
component-options)))
(append
(remove-plist-keys '(:defsystem-depends-on :class) options)
;; cache defsystem-depends-on in canonical form
(when checked-defsystem-depends-on
`(:defsystem-depends-on ,checked-defsystem-depends-on)))))
(set-asdf-cache-entry `(find-system ,name) (list system))
(load-systems* defsystem-dependencies)
;; We change-class AFTER we loaded the defsystem-depends-on
;; since the class might be defined as part of those.
(let ((class (class-for-type nil class)))
......
;;; -*- Lisp -*-
(defsystem test-defsystem-depends-on-missing-system
:defsystem-depends-on (nonexistent-system))
......@@ -38,3 +38,12 @@
:defsystem-depends-on ((:feature ,*newsym* "test-defsystem-depends-on-3"))))
(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