From eb118038fe6f31b17bfb600048fde24c40cb4a7e Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <fare@tunes.org> Date: Wed, 24 Feb 2010 10:06:06 -0500 Subject: [PATCH] Create packages in a way that is more compatible with hot-upgrade. Bug noticed by Tobias C. Rittweiler when upgrading from ECL's ASDF 1.604 to the latest 1.622 or such. --- asdf.lisp | 302 ++++++++++++++++++++++++++++++------------------------ 1 file changed, 167 insertions(+), 135 deletions(-) diff --git a/asdf.lisp b/asdf.lisp index 3f230d51..da6c7460 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -53,146 +53,178 @@ #+ecl (require 'cmp) -(defpackage #:asdf-utilities - (:nicknames :asdf-extensions) - (:use #:common-lisp) - (:export - #:absolute-pathname-p - #:aif - #:appendf - #:asdf-message - #:coerce-name - #:directory-pathname-p - #:ends-with - #:ensure-directory-pathname - #:getenv - #:get-uid - #:length=n-p - #:make-collector - #:pathname-directory-pathname - #:pathname-sans-name+type ;; deprecated. Use pathname-directory-pathname - #:read-file-forms - #:remove-keys - #:remove-keyword - #:resolve-symlinks - #:split - #:component-name-to-pathname-components - #:system-registered-p - #:truenamize)) - -;;;; ------------------------------------------------------------------------- -;;;; Cleanups in case of hot-upgrade. -;;;; Things to do in case we're upgrading from a previous version of ASDF. +;;;; Create packages in a way that is compatible with hot-upgrade. ;;;; See https://bugs.launchpad.net/asdf/+bug/485687 -;;;; These must come *before* the defpackage form. ;;;; See more at the end of the file. -(eval-when (:compile-toplevel :load-toplevel :execute) - (block nil - (let ((asdf (or (find-package :asdf) (return)))) - (flet ((frob (name) - (let ((sym (find-symbol (string name) asdf))) - (when sym - (unexport sym asdf) - (unintern sym asdf))))) - (frob '#:*asdf-revision*) - (do-external-symbols (sym (or (find-package :asdf-utilities) (return))) - (unless (eq sym (find-symbol (string sym) asdf)) - (frob sym))))))) - -(defpackage #:asdf - (:documentation "Another System Definition Facility") - (:use :common-lisp :asdf-utilities) - (:export #:defsystem #:oos #:operate #:find-system #:run-shell-command - #:system-definition-pathname #:find-component ; miscellaneous - #:compile-system #:load-system #:test-system - #:compile-op #:load-op #:load-source-op - #:test-op - #:operation ; operations - #:feature ; sort-of operation - #:version ; metaphorically sort-of an operation - - #:input-files #:output-files #:perform ; operation methods - #:operation-done-p #:explain - - #:component #:source-file - #:c-source-file #:cl-source-file #:java-source-file - #:static-file - #:doc-file - #:html-file - #:text-file - #:source-file-type - #:module ; components - #:system - #:unix-dso - - #:module-components ; component accessors - #:component-pathname - #:component-relative-pathname - #:component-name - #:component-version - #:component-parent - #:component-property - #:component-system - - #:component-depends-on - - #:system-description - #:system-long-description - #:system-author - #:system-maintainer - #:system-license - #:system-licence - #:system-source-file - #:system-relative-pathname - #:map-systems - - #:operation-on-warnings - #:operation-on-failure +(eval-when (:load-toplevel :compile-toplevel :execute) + (labels ((rename-away (package) + (loop :with name = (package-name package) + :for i :from 1 :for n = (format nil "~A.~D" name i) + :unless (find-package n) :do (rename-package package name))) + (ensure-exists (name nicknames) + (let* ((previous + (remove-duplicates + (remove-if + #'null + (mapcar #'find-package (cons name nicknames))) + :from-end t))) + (cond + (previous + (map () #'rename-away (cdr previous)) + (rename-package (car previous) name nicknames) + (car previous)) + (t + (make-package name :nicknames nicknames))))) + (remove-symbol (symbol package) + (let ((sym (find-symbol (string symbol) package))) + (when sym + (unexport sym package) + (unintern sym package)))) + (ensure-unintern (package symbols) + (dolist (sym symbols) (remove-symbol sym package))) + (ensure-use (package use) + (dolist (used use) + (do-external-symbols (sym used) + (unless (eq sym (find-symbol (string sym) package)) + (remove-symbol sym package))) + (use-package used package))) + (ensure-export (package export) + (let ((syms (loop :for x :in export :collect + (intern (string x) package)))) + (do-external-symbols (sym package) + (unless (member sym syms) + (remove-symbol sym package))) + (dolist (sym syms) + (export sym package)))) + (ensure-package (name &key nicknames use export unintern) + (let* ((p (ensure-exists name nicknames))) + (ensure-use p use) + (ensure-unintern p unintern) + (ensure-export p export) + p))) + (ensure-package + ':asdf-utilities + :nicknames '(#:asdf-extensions) + :use '(#:common-lisp) + :export + '(#:absolute-pathname-p + #:aif + #:appendf + #:asdf-message + #:coerce-name + #:directory-pathname-p + #:ends-with + #:ensure-directory-pathname + #:getenv + #:get-uid + #:length=n-p + #:make-collector + #:pathname-directory-pathname + #:pathname-sans-name+type ;; deprecated. Use pathname-directory-pathname + #:read-file-forms + #:remove-keys + #:remove-keyword + #:resolve-symlinks + #:split + #:component-name-to-pathname-components + #:system-registered-p + #:truenamize)) + (ensure-package + ':asdf + :use '(:common-lisp :asdf-utilities) + :unintern '(#:*asdf-revision*) + :export + '(#:defsystem #:oos #:operate #:find-system #:run-shell-command + #:system-definition-pathname #:find-component ; miscellaneous + #:compile-system #:load-system #:test-system + #:compile-op #:load-op #:load-source-op + #:test-op + #:operation ; operations + #:feature ; sort-of operation + #:version ; metaphorically sort-of an operation + + #:input-files #:output-files #:perform ; operation methods + #:operation-done-p #:explain + + #:component #:source-file + #:c-source-file #:cl-source-file #:java-source-file + #:static-file + #:doc-file + #:html-file + #:text-file + #:source-file-type + #:module ; components + #:system + #:unix-dso + + #:module-components ; component accessors + #:component-pathname + #:component-relative-pathname + #:component-name + #:component-version + #:component-parent + #:component-property + #:component-system + + #:component-depends-on + + #:system-description + #:system-long-description + #:system-author + #:system-maintainer + #:system-license + #:system-licence + #:system-source-file + #:system-relative-pathname + #:map-systems + + #:operation-on-warnings + #:operation-on-failure ;#:*component-parent-pathname* - #:*system-definition-search-functions* - #:*central-registry* ; variables - #:*compile-file-warnings-behaviour* - #:*compile-file-failure-behaviour* - #:*resolve-symlinks* - - #:asdf-version - - #:operation-error #:compile-failed #:compile-warned #:compile-error - #:error-name - #:error-pathname - #:missing-definition - #:error-component #:error-operation - #:system-definition-error - #:missing-component - #:missing-component-of-version - #:missing-dependency - #:missing-dependency-of-version - #:circular-dependency ; errors - #:duplicate-names - - #:try-recompiling - #:retry - #:accept ; restarts - #:coerce-entry-to-directory - #:remove-entry-from-registry - - #:standard-asdf-method-combination - #:around ; protocol assistants - - #:initialize-output-translations - #:clear-output-translations - #:ensure-output-translations - #:apply-output-translations - #:compile-file-pathname* - - #:*default-source-registries* - #:initialize-source-registry - #:compute-source-registry - #:clear-source-registry - #:ensure-source-registry - #:process-source-registry)) + #:*system-definition-search-functions* + #:*central-registry* ; variables + #:*compile-file-warnings-behaviour* + #:*compile-file-failure-behaviour* + #:*resolve-symlinks* + + #:asdf-version + + #:operation-error #:compile-failed #:compile-warned #:compile-error + #:error-name + #:error-pathname + #:missing-definition + #:error-component #:error-operation + #:system-definition-error + #:missing-component + #:missing-component-of-version + #:missing-dependency + #:missing-dependency-of-version + #:circular-dependency ; errors + #:duplicate-names + + #:try-recompiling + #:retry + #:accept ; restarts + #:coerce-entry-to-directory + #:remove-entry-from-registry + + #:standard-asdf-method-combination + #:around ; protocol assistants + + #:initialize-output-translations + #:clear-output-translations + #:ensure-output-translations + #:apply-output-translations + #:compile-file-pathname* + + #:*default-source-registries* + #:initialize-source-registry + #:compute-source-registry + #:clear-source-registry + #:ensure-source-registry + #:process-source-registry)))) #+nil (error "The author of this file habitually uses #+nil to comment out ~ -- GitLab