Commit d71e2dc1 authored by Robert Goldman's avatar Robert Goldman
Browse files

Merge branch 'iss51' into 'master'

Old package local nicknames not cleared by DEFINE-PACKAGE

Closes #51

See merge request !167
parents 6b0311e1 caf89a8a
......@@ -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
......
......@@ -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:
......
......@@ -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
......
;;; -*- 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>.
......
......@@ -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)))))
......@@ -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)))
......
......@@ -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"
......
......@@ -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)))
......
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