Commit 9ad85d7d authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Gracefully handle the case where a package-system is missing a package.

This bug was found while testing with ECL, which somehow
evaluated the .asd twice during test-bundle.script
when other implementations evaluated it only once;
which revealed that the second time around,
the package-system would override the explicit secondary definitions
of test-asdf/dll-test and test-asdf/dll-user, and then
would fail ungracefully due to the absence of defpackage in these files.
That latent bug was present in all implementations,
but not stressed by the test system.
parent aab8ba72
...@@ -119,6 +119,7 @@ ...@@ -119,6 +119,7 @@
#:missing-dependency-of-version #:missing-dependency-of-version
#:circular-dependency ; errors #:circular-dependency ; errors
#:duplicate-names #:non-toplevel-system #:non-system-system #:duplicate-names #:non-toplevel-system #:non-system-system
#:try-recompiling #:try-recompiling
#:retry #:retry
...@@ -8,7 +8,7 @@ ...@@ -8,7 +8,7 @@
:asdf/upgrade :asdf/component :asdf/system :asdf/find-system :asdf/lisp-action) :asdf/upgrade :asdf/component :asdf/system :asdf/find-system :asdf/lisp-action)
(:export (:export
#:package-system #:register-system-packages #:sysdef-package-system-search #:package-system #:register-system-packages #:sysdef-package-system-search
#:*defpackage-forms* #:*package-systems*)) #:*defpackage-forms* #:*package-systems* #:package-system-missing-package-error))
(in-package :asdf/package-system) (in-package :asdf/package-system)
(with-upgradability () (with-upgradability ()
...@@ -31,14 +31,21 @@ ...@@ -31,14 +31,21 @@
(member (car form) *defpackage-forms*))) (member (car form) *defpackage-forms*)))
(defun stream-defpackage-form (stream) (defun stream-defpackage-form (stream)
(loop :for form = (read stream) (loop :for form = (read stream nil nil) :while form
:when (defpackage-form-p form) :when (defpackage-form-p form) :return form))
:return form))
(defun file-defpackage-form (file) (defun file-defpackage-form (file)
(with-input-file (f file) (with-input-file (f file)
(stream-defpackage-form f))) (stream-defpackage-form f)))
(define-condition package-system-missing-package-error (system-definition-error)
((system :initarg :system :reader error-system)
(pathname :initarg :pathname :reader error-pathname))
(:report (lambda (c s)
(format s (compatfmt "~@<No package form found while ~
trying to define package-system ~A from file ~A~>")
(error-system c) (error-pathname c)))))
(defun package-dependencies (defpackage-form) (defun package-dependencies (defpackage-form)
(assert (defpackage-form-p defpackage-form)) (assert (defpackage-form-p defpackage-form))
(remove-duplicates (remove-duplicates
...@@ -69,10 +76,10 @@ ...@@ -69,10 +76,10 @@
system-name system-name
(string-downcase package-name))) (string-downcase package-name)))
(defun package-system-file-dependencies (file) (defun package-system-file-dependencies (file &optional system)
(let* ((defpackage-form (file-defpackage-form file)) (if-let (defpackage-form (file-defpackage-form file))
(package-dependencies (package-dependencies defpackage-form))) (remove t (mapcar 'package-name-system (package-dependencies defpackage-form)))
(remove t (mapcar 'package-name-system package-dependencies)))) (error 'package-system-missing-package-error :system system :pathname file)))
(defun same-package-system-p (system name directory subpath dependencies) (defun same-package-system-p (system name directory subpath dependencies)
(and (eq (type-of system) 'package-system) (and (eq (type-of system) 'package-system)
...@@ -97,7 +104,7 @@ ...@@ -97,7 +104,7 @@
(f (probe-file* (subpathname dir sub :type "lisp") (f (probe-file* (subpathname dir sub :type "lisp")
:truename *resolve-symlinks*))) :truename *resolve-symlinks*)))
(when (file-pathname-p f) (when (file-pathname-p f)
(let ((dependencies (package-system-file-dependencies f)) (let ((dependencies (package-system-file-dependencies f system))
(previous (cdr (system-registered-p system)))) (previous (cdr (system-registered-p system))))
(if (same-package-system-p previous system dir sub dependencies) (if (same-package-system-p previous system dir sub dependencies)
previous previous
(defpackage :test-asdf/dll-test (:use)) ;; dummy, for package-system dependencies.
#+ecl #+ecl
(ffi:clines " (ffi:clines "
extern int sample_function(); extern int sample_function();
;; Let's not even include a dummy defpackage form.
;; (defpackage :test-asdf/dll-user (:use)) ;; dummy, for package-system dependencies.
(in-package :test-package) (in-package :test-package)
(ffi:def-function "sample_function" () :returning :int) (ffi:def-function "sample_function" () :returning :int)
(register-directory (subpathname *test-directory* "package-system-test/")) (register-directory (subpathname *test-directory* "package-system-test/"))
(load-system :package-system-test/a/x) (load-system :package-system-test/a/x)
(load-system :package-system-test/d) (load-system :package-system-test/d)
(signals package-system-missing-package-error (load-system :package-system-test/e))
;; No such file.
(signals missing-component (load-system :package-system-test/f))
;; This file is missing a defpackage form, and loading it as a package-system should trigger an error.
(in-package :asdf-test)
...@@ -71,6 +71,3 @@ ...@@ -71,6 +71,3 @@
(defsystem :test-asdf/bundle-2 (defsystem :test-asdf/bundle-2
:depends-on (:test-asdf/bundle-1) :components ((:file "file2"))) :depends-on (:test-asdf/bundle-1) :components ((:file "file2")))
(defsystem :test-asdf/dll-test :components ((:file "dll-test")))
(defsystem :test-asdf/dll-user :components ((:file "dll-user")))
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