Commit 3bf05c7a authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.014.7: Fix ECL upgrade by moving code back from asdf-ecl to asdf

Cleanup the search-for-system-definition protocol.
Define upgrade-asdf function.
Cache the source-registry scan in a hash-table.
parent 60c67379
......@@ -13,45 +13,6 @@
(in-package :asdf)
;;;
;;; We rewrite a subset of ASDF functions so that instead of generating one
;;; FASL file per lisp file, ASDF creates an object file and a FASL file. The
;;; object file is reused by the extensions below.
;;;
(setf *compile-op-compile-file-function*
(lambda (input-file &rest keys &key output-file &allow-other-keys)
(declare (ignore output-file))
(multiple-value-bind (object-file flags1 flags2)
(apply #'compile-file* input-file :system-p t keys)
(values (and object-file
(c::build-fasl (compile-file-pathname object-file :type :fasl)
:lisp-files (list object-file))
object-file)
flags1
flags2))))
(defmethod output-files ((operation compile-op) (c cl-source-file))
(declare (ignorable operation))
(let ((p (lispize-pathname (component-pathname c))))
(list (compile-file-pathname p :type :object)
(compile-file-pathname p :type :fasl))))
(defmethod perform ((o load-op) (c cl-source-file))
(map () #'load
(loop :for i :in (input-files o c)
:unless (string= (pathname-type i) "fas")
:collect (compile-file-pathname (lispize-pathname i)))))
;;;
;;; COMPILE-OP / LOAD-OP
;;;
;;; In ECL, these operations produce both FASL files and the
;;; object files that they are built from. Having both of them allows
;;; us to later on reuse the object files for bundles, libraries,
;;; standalone executables, etc.
;;;
;;;
;;; BUNDLE-OP
;;;
......@@ -443,19 +404,8 @@
(export '(make-build load-fasl-op prebuilt-system))
(push '("fasb" . si::load-binary) si::*load-hooks*)
(defvar *require-asdf-operator* 'load-op)
(defun module-provide-asdf (name)
(handler-bind ((style-warning #'muffle-warning))
(let* ((*verbose-out* (make-broadcast-stream))
(system (asdf:find-system name nil)))
(when system
(asdf:operate *require-asdf-operator* name)
t))))
(defun register-pre-built-system (name)
(register-system name (make-instance 'system :name name
:source-file nil)))
(register-system name (make-instance 'system :name name :source-file nil)))
(setf si::*module-provider-functions*
(loop :for f :in si::*module-provider-functions*
......@@ -465,7 +415,7 @@
(and (first l) (register-pre-built-system name))
(values-list l)))))
#+win32 (push '("asd" . si::load-source) si::*load-hooks*)
(pushnew 'module-provide-asdf ext:*module-provider-functions*)
(pushnew 'module-provide-asdf si:*module-provider-functions*)
(pushnew (translate-logical-pathname "SYS:") *central-registry*)
(provide :asdf)
......@@ -12,7 +12,7 @@
:licence "MIT"
:description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.014.6" ;; to be automatically updated by bin/bump-revision
:version "2.014.7" ;; to be automatically updated by bin/bump-revision
:depends-on ()
:components
((:file "asdf")
......
This diff is collapsed.
......@@ -300,6 +300,21 @@ This applies to e.g. CFFI-Grovel, or to hacks used by ironclad, etc.
It is safer if you upgrade ASDF and its extensions as a special step
at the very beginning of whatever script you are running,
before you start using ASDF to load anything else.
@item
It is unsafe to upgrade ASDF as part of loading a system
that depends on a more recent version of ASDF,
since the new one might shadow the old one while the old one is running,
and the running old one will be confused
when extensions are loaded into the new one.
We recommend that your systems should @emph{not} specify
@code{:depends-on (:asdf)}, or @code{:depends-on ((:version :asdf "2.010"))},
but instead that they check that a recent enough ASDF is installed,
with such code as:
@example
(unless (or #+asdf2 (asdf:version-satisfies
(asdf:asdf-version) *required-asdf-version*))
(error "FOO requires ASDF ~A or later." *required-asdf-version*))
@end example
@end itemize
......
......@@ -272,9 +272,13 @@
(setf (logical-pathname-translations "ASDFTEST") nil))
(remhash "test-system" asdf::*defined-systems*)))
(defun hash-table->alist (table)
(loop :for key :being :the :hash-keys :of table :using (:hash-value value)
:collect (cons key value)))
(quit-on-error
(asdf:initialize-source-registry)
(format t "source registry: ~S~%" (asdf::source-registry))
(format t "source registry: ~S~%" (hash-table->alist asdf::*source-registry*))
(asdf:initialize-output-translations)
(format t "output translations: ~S~%" (asdf::output-translations))
......
......@@ -4,7 +4,6 @@
(quit-on-error
(setf asdf:*central-registry* '(*default-pathname-defaults*))
(trace asdf:perform)
(asdf:load-system 'test-module-pathnames)
(flet ((submodule (module name)
(find name (asdf:module-components module)
......
......@@ -4,7 +4,6 @@
(quit-on-error
(setf asdf:*central-registry* '(*default-pathname-defaults*))
(trace asdf:perform)
(asdf:load-system 'test-system-pathnames)
(flet ((submodule (module name)
(find name (asdf:module-components module)
......
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