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

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 @@
#:missing-dependency-of-version
#:circular-dependency ; errors
#:duplicate-names #:non-toplevel-system #:non-system-system
#:package-system-missing-package-error
#:try-recompiling
#:retry
......
......@@ -8,7 +8,7 @@
:asdf/upgrade :asdf/component :asdf/system :asdf/find-system :asdf/lisp-action)
(:export
#: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)
(with-upgradability ()
......@@ -31,14 +31,21 @@
(member (car form) *defpackage-forms*)))
(defun stream-defpackage-form (stream)
(loop :for form = (read stream)
:when (defpackage-form-p form)
:return form))
(loop :for form = (read stream nil nil) :while form
:when (defpackage-form-p form) :return form))
(defun file-defpackage-form (file)
(with-input-file (f file)
(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)
(assert (defpackage-form-p defpackage-form))
(remove-duplicates
......@@ -69,10 +76,10 @@
system-name
(string-downcase package-name)))
(defun package-system-file-dependencies (file)
(let* ((defpackage-form (file-defpackage-form file))
(package-dependencies (package-dependencies defpackage-form)))
(remove t (mapcar 'package-name-system package-dependencies))))
(defun package-system-file-dependencies (file &optional system)
(if-let (defpackage-form (file-defpackage-form file))
(remove t (mapcar 'package-name-system (package-dependencies defpackage-form)))
(error 'package-system-missing-package-error :system system :pathname file)))
(defun same-package-system-p (system name directory subpath dependencies)
(and (eq (type-of system) 'package-system)
......@@ -97,7 +104,7 @@
(f (probe-file* (subpathname dir sub :type "lisp")
:truename *resolve-symlinks*)))
(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))))
(if (same-package-system-p previous system dir sub dependencies)
previous
......
(defpackage :test-asdf/dll-test (:use)) ;; dummy, for package-system dependencies.
#+ecl
(ffi:clines "
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)
(ffi:def-function "sample_function" () :returning :int)
(register-directory (subpathname *test-directory* "package-system-test/"))
(load-system :package-system-test/a/x)
(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 @@
(defsystem :test-asdf/bundle-2
: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