diff --git a/asdf.asd b/asdf.asd index 932c5d575c48ee259274473dd56e92c8bb57cc10..218810a0cf5cf67c9425fc5700cfb9ec88a4dd5c 100644 --- a/asdf.asd +++ b/asdf.asd @@ -93,7 +93,7 @@ :licence "MIT" :description "Another System Definition Facility" :long-description "ASDF builds Common Lisp software organized into defined systems." - :version "3.3.4.11" ;; to be automatically updated by make bump-version + :version "3.3.4.12" ;; to be automatically updated by make bump-version :depends-on () :components ((:module "build" :components ((:file "asdf")))) . #-asdf3 () #+asdf3 diff --git a/doc/Changelog b/doc/Changelog index 05d61a8fdfbb637051b7aeed28b8e2e5f7952cbb..898e1756545858dc2399c81a62198561bd365747 100644 --- a/doc/Changelog +++ b/doc/Changelog @@ -3,16 +3,20 @@ cl-asdf (2:3.3.5-1) unstable; urgency=low IN PROGRESS * Fix bug in handling combination of :serial and :if-feature dependencies. * Add support for package local nicknames to UIOP:DEFINE-PACKAGE and ASDF's package-inferred systems. Extend support for package local - nicknames to more lisp implementations. + nicknames to more lisp implementations. Initial work by + François-René Rideau, with assists from Phoebe Goldman, MichaÅ‚ + Herda, and Eric Timmons. * A number of fixes for Lispworks compatibility (thanks to Martin Simmons). -* Fixes for SBCL and ECL from Eric Timmons. +* Fixes for SBCL and ECL from Eric Timmons and @pouar. * Add support for source files with different file extensions to package-inferred-systems. Thanks to Jingtao Xu for identifying the bug and providing a fix. * Fixes for UIOP:WITH-TEMPORARY-FILE -* Miscellaneous bug fixes from LuÃs Oliveira. +* Miscellaneous bug fixes from LuÃs Oliveira, Gary Palter, François-René + Rideau, and Eric Schulte. * Fix for argument handling in LAUNCH-PROGRAM. +* Fixes for feature handling from Eric Timmons. cl-asdf (2:3.3.4-1) unstable; urgency=low Bug fix release: diff --git a/doc/asdf.texinfo b/doc/asdf.texinfo index 898659feeb50a1671ede0f64243fea7618389196..ef3585ae42c57f002cf4ef9cb713115e7590d2e1 100644 --- a/doc/asdf.texinfo +++ b/doc/asdf.texinfo @@ -65,7 +65,7 @@ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. @titlepage @title ASDF: Another System Definition Facility -@subtitle Manual for Version 3.3.4.11 +@subtitle Manual for Version 3.3.4.12 @c The following two commands start the copyright page. @page @vskip 0pt plus 1filll @@ -82,7 +82,7 @@ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. @node Top, Introduction, (dir), (dir) @top ASDF: Another System Definition Facility @ifnottex -Manual for Version 3.3.4.11 +Manual for Version 3.3.4.12 @end ifnottex diff --git a/header.lisp b/header.lisp index b76559454127f25db542466c8831a619668cc387..cd87b0103e453ea7187797fe906efb36b3b746c5 100644 --- a/header.lisp +++ b/header.lisp @@ -1,5 +1,5 @@ ;;; -*- mode: Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*- -;;; This is ASDF 3.3.4.11: Another System Definition Facility. +;;; This is ASDF 3.3.4.12: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel@common-lisp.net>. diff --git a/test/test-package-local-nicknames.script b/test/test-package-local-nicknames.script index 668bbc1f25b052788984d0f574b90fe499dba4c0..06700b87abae76825d0b4de5062f20fdb4340abd 100644 --- a/test/test-package-local-nicknames.script +++ b/test/test-package-local-nicknames.script @@ -123,3 +123,19 @@ (sb (find-package +nn-name+))) (assert (eq cl (find-package :package-local-nicknames-test-2))) (assert (eq sb (find-package +pkg-name+)))))) + + +(define-test test-package-local-nicknames-nickname-removal-by-define-package + (reset-test-packages) + (uiop:define-package #:foo + (:local-nicknames (#:u #:uiop))) + (assert + (eq (find-package :uiop) + (let ((*package* (find-package '#:foo))) + (find-package '#:u)))) + (uiop:define-package #:foo + (:local-nicknames (#:u #:asdf))) + (assert + (eq (find-package :asdf) + (let ((*package* (find-package '#:foo))) + (find-package '#:u))))) diff --git a/uiop/package.lisp b/uiop/package.lisp index 3c74c5ff54ee3986c80c1500bfc06e1637dcaf79..285539d979a9a9955a60dad3c635b985d81aa586 100644 --- a/uiop/package.lisp +++ b/uiop/package.lisp @@ -602,6 +602,17 @@ or when loading the package is optional." (unless (eq status :external) (ensure-exported name symbol from-package recycle)))) + #+package-local-nicknames + (defun install-package-local-nicknames (destination-package new-nicknames) + ;; First, remove all package-local nicknames. (We'll reinstall any desired ones later.) + (dolist (pair-to-remove (package-local-nicknames destination-package)) + (remove-package-local-nickname (string (car pair-to-remove)) destination-package)) + ;; Then, install all desired nicknames. + (loop :for (nickname package) :in new-nicknames + :do (add-package-local-nickname (string nickname) + (find-package package) + destination-package))) + (defun ensure-package (name &key nicknames documentation use shadow shadowing-import-from @@ -630,13 +641,17 @@ or when loading the package is optional." (exported (make-hash-table :test 'equal)) ; string to bool ;; string to list home package and use package: (inherited (make-hash-table :test 'equal))) - (declare (ignorable local-nicknames)) ; if not supported + #-package-local-nicknames + (declare (ignore local-nicknames)) ; if not supported (when-package-fishiness (record-fishy package-name)) + ;; if supported, put package documentation #-genera (when documentation (setf (documentation package t) documentation)) + ;; remove unwanted packages from use list (loop :for p :in (set-difference (package-use-list package) (append mix use)) :do (note-package-fishiness :over-use name (package-names p)) (unuse-package p package)) + ;; mark unwanted packages for deletion (loop :for p :in discarded :for n = (remove-if #'(lambda (x) (member x names :test 'equal)) (package-names p)) @@ -644,16 +659,12 @@ or when loading the package is optional." (cond (n (rename-package p (first n) (rest n))) (t (rename-package-away p) (push p to-delete)))) + ;; give package its desired name (rename-package package package-name nicknames) ;; Handle local nicknames #+package-local-nicknames - (let* ((existing-nicknames (mapcar #'(lambda (x) (string (car x))) (package-local-nicknames package))) - (new-nicknames (mapcar #'(lambda (x) (string (first x))) local-nicknames)) - (to-remove (set-difference existing-nicknames new-nicknames :test 'equal))) - (mapc #'(lambda (x) (remove-package-local-nickname x package)) to-remove)) - #+package-local-nicknames - (loop :for (nick-str package-str) :in local-nicknames - :do (add-package-local-nickname nick-str package-str package)) + (install-package-local-nicknames package local-nicknames) + ;; handle uninterning unwanted symbols (dolist (name unintern) (multiple-value-bind (existing status) (find-symbol name package) (when status @@ -661,11 +672,14 @@ or when loading the package is optional." (note-package-fishiness :unintern (package-name package) name (symbol-package-name existing) status) (unintern* name package nil))))) + ;; handle exports (dolist (name export) (setf (gethash name exported) t)) + ;; handle reexportss (dolist (p reexport) (do-external-symbols (sym p) (setf (gethash (string sym) exported) t))) + ;; unexport symbols not listed in (re)export (do-external-symbols (sym package) (let ((name (symbol-name sym))) (unless (gethash name exported) @@ -673,6 +687,7 @@ or when loading the package is optional." :over-export (package-name package) name (or (home-package-p sym package) (symbol-package-name sym))) (unexport sym package)))) + ;; handle explicitly listed shadowed ssymbols (dolist (name shadow) (setf (gethash name shadowed) t) (multiple-value-bind (existing status) (find-symbol name package) @@ -692,25 +707,31 @@ or when loading the package is optional." (shadowing-import* dummy package) (import* dummy package))))))) (shadow* name package)) + ;; handle shadowing imports (loop :for (p . syms) :in shadowing-import-from :for pp = (find-package* p) :do (dolist (sym syms) (ensure-shadowing-import (string sym) package pp shadowed imported))) + ;; handle mixed packages (loop :for p :in mix :for pp = (find-package* p) :do (do-external-symbols (sym pp) (ensure-mix (symbol-name sym) sym package pp shadowed imported inherited))) + ;; handle import-from packages (loop :for (p . syms) :in import-from :for pp = (find-package p) :do (dolist (sym syms) (ensure-import (symbol-name sym) package pp shadowed imported))) + ;; handle use-list and mix (dolist (p (append use mix)) (do-external-symbols (sym p) (ensure-inherited (string sym) sym package p nil shadowed imported inherited)) (use-package p package)) (loop :for name :being :the :hash-keys :of exported :do (ensure-symbol name package t recycle shadowed imported inherited exported) (ensure-export name package recycle)) + ;; intern dessired symbols (dolist (name intern) (ensure-symbol name package t recycle shadowed imported inherited exported)) (do-symbols (sym package) (ensure-symbol (symbol-name sym) package nil recycle shadowed imported inherited exported)) + ;; delete now-deceased packages (map () 'delete-package* to-delete) package))) diff --git a/uiop/version.lisp b/uiop/version.lisp index cb56daa69ba2a5940f105d2c02c3d8701b7b24be..a9657284d0ccc57ed607092670346126eac85779 100644 --- a/uiop/version.lisp +++ b/uiop/version.lisp @@ -12,7 +12,7 @@ (in-package :uiop/version) (with-upgradability () - (defparameter *uiop-version* "3.3.4.11") + (defparameter *uiop-version* "3.3.4.12") (defun unparse-version (version-list) "From a parsed version (a list of natural numbers), compute the version string" diff --git a/upgrade.lisp b/upgrade.lisp index de0a5250435845c220c57d834fe8bb02a811aa99..50e2e20dcfebf0a98fa6bcc4eeb05ae467fbc107 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -94,7 +94,7 @@ previously-loaded version of ASDF." ;; "3.4.5.67" would be a development version in the official branch, on top of 3.4.5. ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5 ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67 - (asdf-version "3.3.4.11") + (asdf-version "3.3.4.12") (existing-version (asdf-version))) (setf *asdf-version* asdf-version) (when (and existing-version (not (equal asdf-version existing-version))) diff --git a/version.lisp-expr b/version.lisp-expr index b5e50b8faa5f82f41829a2438cd1d79428531ca1..84a561bb9ff61b9298370edcd392ed1af8549905 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1,2 +1,2 @@ -"3.3.4.11" +"3.3.4.12"