Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Tarn Burton
asdf
Commits
823c389f
Commit
823c389f
authored
May 17, 2020
by
Francois-Rene Rideau
Committed by
Robert Goldman
Jun 03, 2021
Browse files
Make PACKAGE-LOCAL-NICKNAMES support upgradable
parent
0d9883a9
Changes
4
Hide whitespace changes
Inline
Side-by-side
test/test-package-local-nicknames.script
View file @
823c389f
...
...
@@ -62,7 +62,7 @@
:package-local-nicknames-test-1
:package-local-nicknames-test-2
))
(
let
((
*package*
(
find-package
p
)))
(
let
((
alist
(
uiop/package:package-local-nicknames
:package-local-nicknames-test-1
)))
(
let
((
alist
(
uiop/package
*
:package-local-nicknames
:package-local-nicknames-test-1
)))
(
assert
(
equal
(
cons
(
case-lisp-string
"L"
)
(
find-package
:cl
))
(
assoc
(
case-lisp-string
"L"
)
alist
:test
'string=
)))
(
assert
(
equal
(
cons
+nn-sname+
(
find-package
+pkg-sname+
))
...
...
@@ -95,28 +95,28 @@
(
define-test
test-package-local-nicknames-nickname-removal
(
reset-test-packages
)
(
assert
(
=
2
(
length
(
uiop/package:package-local-nicknames
:package-local-nicknames-test-1
))))
(
assert
(
uiop/package:remove-package-local-nickname
:l
:package-local-nicknames-test-1
))
(
assert
(
=
1
(
length
(
uiop/package:package-local-nicknames
:package-local-nicknames-test-1
))))
(
assert
(
=
2
(
length
(
uiop/package
*
:package-local-nicknames
:package-local-nicknames-test-1
))))
(
assert
(
uiop/package
*
:remove-package-local-nickname
:l
:package-local-nicknames-test-1
))
(
assert
(
=
1
(
length
(
uiop/package
*
:package-local-nicknames
:package-local-nicknames-test-1
))))
(
let
((
*package*
(
find-package
:package-local-nicknames-test-1
)))
(
assert
(
not
(
find-package
:l
)))))
(
define-test
test-package-local-nicknames-nickname-removal-char
#+
ignore
(
declare
(
optimize
(
debug
3
)
(
speed
0
)))
(
reset-test-packages
)
(
assert
(
=
2
(
length
(
uiop/package:package-local-nicknames
:package-local-nicknames-test-1
))))
(
assert
(
uiop/package:remove-package-local-nickname
(
if
(
eq
(
readtable-case
*readtable*
)
:preserve
)
#\l
#\L
)
(
assert
(
=
2
(
length
(
uiop/package
*
:package-local-nicknames
:package-local-nicknames-test-1
))))
(
assert
(
uiop/package
*
:remove-package-local-nickname
(
if
(
eq
(
readtable-case
*readtable*
)
:preserve
)
#\l
#\L
)
:package-local-nicknames-test-1
))
(
assert
(
=
1
(
length
(
uiop/package:package-local-nicknames
:package-local-nicknames-test-1
))))
(
assert
(
=
1
(
length
(
uiop/package
*
:package-local-nicknames
:package-local-nicknames-test-1
))))
(
let
((
*package*
(
find-package
:package-local-nicknames-test-1
)))
(
assert
(
not
(
find-package
:l
)))))
(
define-test
test-package-local-nicknames-nickname-removal-readd-another-package-equality
(
reset-test-packages
)
(
assert
(
uiop/package:remove-package-local-nickname
:l
:package-local-nicknames-test-1
))
(
assert
(
uiop/package
*
:remove-package-local-nickname
:l
:package-local-nicknames-test-1
))
(
assert
(
eq
(
find-package
:package-local-nicknames-test-1
)
(
uiop/package:add-package-local-nickname
:l
:package-local-nicknames-test-2
(
uiop/package
*
:add-package-local-nickname
:l
:package-local-nicknames-test-2
:package-local-nicknames-test-1
)))
(
let
((
*package*
(
find-package
:package-local-nicknames-test-1
)))
(
let
((
cl
(
find-package
:l
))
...
...
uiop/driver.lisp
View file @
823c389f
...
...
@@ -2,18 +2,21 @@
;;;; Re-export all the functionality in UIOP
(
uiop/package:define-package
:uiop/driver
(
:nicknames
:uiop
:asdf/driver
)
;; asdf/driver is obsolete (uiop isn't);
;; but asdf/driver is still used by swap-bytes, static-vectors.
(
:nicknames
:uiop
;; Official name we recommend should be used for all references to uiop symbols.
:asdf/driver
)
;; DO NOT USE, a deprecated name, not supported anymore.
;; We should remove the name :asdf/driver at some point,
;; but not until it has been eradicated from Quicklisp for a year or two.
;; The last known user was cffi (PR merged in May 2020).
(
:use
:uiop/common-lisp
)
;; NB: not reexporting uiop/common-lisp
;; which include all of CL with compatibility modifications on select platforms,
;; that
c
ould cause potential conflicts for packages that
would :use (cl uiop)
;; or :use (closer-common-lisp uiop), etc.
;; NB:
We are
not reexporting uiop/common-lisp
;; which include all of CL with compatibility modifications on select platforms,
;;
because
that
w
ould cause potential conflicts for packages that
;;
might want to :use (:cl :uiop)
or :use (
:
closer-common-lisp
:
uiop), etc.
(
:use-reexport
:uiop/package
:uiop/utility
:uiop/version
:uiop/package
*
:uiop/utility
:uiop/version
:uiop/os
:uiop/pathname
:uiop/filesystem
:uiop/stream
:uiop/image
:uiop/launch-program
:uiop/run-program
:uiop/lisp-build
:uiop/configuration
:uiop/backward-driver
))
;; Provide both lowercase and uppercase, to satisfy more
people
.
;; Provide both lowercase and uppercase, to satisfy more
implementations
.
(
provide
"uiop"
)
(
provide
"UIOP"
)
uiop/package.lisp
View file @
823c389f
...
...
@@ -4,39 +4,40 @@
;; See https://bugs.launchpad.net/asdf/+bug/485687
;;
;; CAUTION: The definition of the UIOP/PACKAGE package MUST NOT CHANGE,
;; NOT NOW, NOT EVER, NOT UNDER ANY CIRCUMSTANCE. NEVER.
;; ... and the same goes for UIOP/PACKAGE-LOCAL-NICKNAMES.
;;
;; The entire point of UIOP/PACKAGE is to address the fact that the CL standard
;; *leaves it unspecified what happens when a package is redefined incompatibly*.
;; For instance, SBCL 1.4.2 will signal a full WARNING when this happens,
;; throwing a wrench in upgrading code with ASDF itself, while continuing to
;; export old symbols it now shouldn't as it also exports new ones,
;; causing problems with code that relies on the new/current exports.
;; CLISP and CCL also exports both sets of symbols, though without any WARNING.
;; ABCL 1.6.1 will plainly ignore the new definition.
;; Other implementations may do whatever they want and change their behavior at any time.
;; ***Using DEFPACKAGE twice with different definitions is nasal-demon territory.***
;;
;; Thus we define UIOP/PACKAGE:DEFINE-PACKAGE with which packages can be defined
;; in an upgrade-friendly way: the new definition is authoritative, and
;; the package will define and export exactly those symbols in the new definition,
;; no more and no fewer, whereas it is well-defined what happens to previous symbols.
;; However, for obvious bootstrap reasons, we cannot use DEFINE-PACKAGE
;; to define UIOP/PACKAGE itself, only DEFPACKAGE.
;; Therefore, unlike the other packages in ASDF, UIOP/PACKAGE is immutable,
;; now and forever. It is frozen for the aeons to come, like the CL package itself,
;; to the same exact state it was defined at its inception, in ASDF 2.27 in 2013.
;; The same goes for UIOP/PACKAGE-LOCAL-NICKNAMES, that we use internally.
;;
;; If you ever must define new symbols in this file, you can and must
;; export them from a different package, possibly defined in the same file,
;; say a package UIOP/PACKAGE* defined at the end of this file with DEFINE-PACKAGE,
;; that might use :import-from to import the symbols from UIOP/PACKAGE,
;; if you must somehow define them in UIOP/PACKAGE.
;;; package local nicknames feature. Can't be deferred until common-lisp.lisp,
;;; where most such features are set.
;;; ABCL and CCL already define this feature appropriately.
;;; Seems to be unconditionally present for SBCL, ACL, and clasp
;;; Don't know about ecl, or others
(
eval-when
(
:load-toplevel
:compile-toplevel
:execute
)
;; abcl pushes :package-local-nicknames without UIOP interfering,
;; and Lispworks will do so
#+
(
or
sbcl
clasp
)
(
pushnew
:package-local-nicknames
*features*
)
#+
allegro
(
let
((
fname
(
find-symbol
(
symbol-name
'
#:add-package-local-nickname
)
'
#:excl
)))
(
when
(
and
fname
(
fboundp
fname
))
(
pushnew
:package-local-nicknames
*features*
))))
(
defpackage
:uiop/package
;; CAUTION: we must handle the first few packages specially for hot-upgrade.
;; This package definition MUST NOT change unless its name too changes;
;; if/when it changes, don't forget to add new functions missing from below.
;; Until then, uiop/package is frozen to forever
;; import and export the same exact symbols as for ASDF 2.27.
;; Any other symbol must be import-from'ed and re-export'ed in a different package.
(
defpackage
:uiop/package
;;; THOU SHALT NOT modify this definition, EVER. See explanations above.
(
:use
:common-lisp
)
#+
package-local-nicknames
(
:import-from
#+
allegro
#:excl
#+
sbcl
#:sb-ext
#+
(
or
clasp
abcl
ecl
)
#:ext
#+
ccl
#:ccl
#+
lispworks
#:hcl
#-
(
or
allegro
sbcl
clasp
abcl
ccl
lispworks
ecl
)
(
error
"Don't know from which package this lisp supplies the local-package-nicknames API."
)
#:remove-package-local-nickname
#:package-local-nicknames
#:add-package-local-nickname
)
(
:export
#:find-package*
#:find-symbol*
#:symbol-call
#:intern*
#:export*
#:import*
#:shadowing-import*
#:shadow*
#:make-symbol*
#:unintern*
...
...
@@ -48,13 +49,43 @@
#:package-names
#:packages-from-names
#:fresh-package-name
#:rename-package-away
#:package-definition-form
#:parse-define-package-form
#:ensure-package
#:define-package
#+
package-local-nicknames
#:add-package-local-nickname
#+
package-local-nicknames
#:remove-package-local-nickname
#+
package-local-nicknames
#:package-local-nicknames
))
(
in-package
:uiop/package
)
;;; package local nicknames feature.
;;; This can't be deferred until common-lisp.lisp, where most such features are set.
;;; ABCL and CCL already define this feature appropriately.
;;; Seems to be unconditionally present for SBCL, ACL, and CLASP
;;; Don't know about ECL, or others
(
eval-when
(
:load-toplevel
:compile-toplevel
:execute
)
;; ABCL pushes :package-local-nicknames without UIOP interfering,
;; and Lispworks will do so
#+
(
or
sbcl
clasp
)
(
pushnew
:package-local-nicknames
*features*
)
#+
allegro
(
let
((
fname
(
find-symbol
(
symbol-name
'
#:add-package-local-nickname
)
'
#:excl
)))
(
when
(
and
fname
(
fboundp
fname
))
(
pushnew
:package-local-nicknames
*features*
))))
;;; THOU SHALT NOT modify this definition, EVER, *EXCEPT* to add a new implementation.
;; If you somehow need to modify the API in any way,
;; you will need to create another, differently named, and just as immutable package.
#+
package-local-nicknames
(
defpackage
:uiop/package-local-nicknames
(
:use
:cl
)
(
:import-from
#+
allegro
#:excl
#+
sbcl
#:sb-ext
#+
(
or
clasp
abcl
ecl
)
#:ext
#+
ccl
#:ccl
#+
lispworks
#:hcl
#-
(
or
allegro
sbcl
clasp
abcl
ccl
lispworks
ecl
)
(
error
"Don't know from which package this lisp supplies the local-package-nicknames API."
)
#:remove-package-local-nickname
#:package-local-nicknames
#:add-package-local-nickname
)
(
:export
#:add-package-local-nickname
#:remove-package-local-nickname
#:package-local-nicknames
))
;;;; General purpose package utilities
(
eval-when
(
:load-toplevel
:compile-toplevel
:execute
)
...
...
@@ -663,8 +694,15 @@ or when loading the package is optional."
(
rename-package
package
package-name
nicknames
)
;; Handle local nicknames
#+
package-local-nicknames
(
install-package-local-nicknames
package
local-nicknames
)
;; handle uninterning unwanted symbols
(
let*
((
existing-nicknames
(
mapcar
#'
(
lambda
(
x
)
(
string
(
car
x
)))
(
uiop/package-local-nicknames:package-local-nicknames
package
)))
(
new-nicknames
(
mapcar
#'
(
lambda
(
x
)
(
string
(
first
x
)))
local-nicknames
))
(
to-remove
(
set-difference
existing-nicknames
new-nicknames
:test
'equal
)))
(
map
()
#'
(
lambda
(
x
)
(
uiop/package-local-nicknames:remove-package-local-nickname
x
package
))
to-remove
)
(
loop
:for
(
nick-str
package-str
)
:in
local-nicknames
:do
(
uiop/package-local-nicknames:add-package-local-nickname
nick-str
package-str
package
)))
(
dolist
(
name
unintern
)
(
multiple-value-bind
(
existing
status
)
(
find-symbol
name
package
)
(
when
status
...
...
@@ -818,3 +856,8 @@ MIX directives, and reexport their contents as per the REEXPORT directive."
#+
(
or
clasp
ecl
gcl
mkcl
)
(
defpackage
,
package
(
:use
))
(
eval-when
(
:compile-toplevel
:load-toplevel
:execute
)
,
ensure-form
))))
;; This package, unlike UIOP/PACKAGE, is allowed to evolve and acquire new symbols or drop old ones.
(
define-package
:uiop/package*
(
:use-reexport
:uiop/package
#+
package-local-nicknames
:uiop/package-local-nicknames
))
uiop/utility.lisp
View file @
823c389f
...
...
@@ -44,7 +44,8 @@
;; so that new definitions are always seen by all callers, even those up the stack.
;; - WITH-UPGRADABILITY also uses EVAL-WHEN so that definitions used by ASDF are in a limbo state
;; (especially for gf's) in between the COMPILE-OP and LOAD-OP operations on the defining file.
;; - THOU SHALT NOT redefine a function with a backward-incompatible semantics without renaming it.
;; - THOU SHALT NOT redefine a function with a backward-incompatible semantics without renaming it,
;; at least if that function is used by ASDF while performing the plan to load ASDF.
;; - THOU SHALT change the name of a function whenever thou makest an incompatible change.
;; - For instance, when the meanings of NIL and T for timestamps was inverted,
;; functions in the STAMP<, STAMP<=, etc. family had to be renamed to TIMESTAMP<, TIMESTAMP<=, etc.,
...
...
@@ -53,9 +54,8 @@
;; even in a backward-compatible way, you MUST precede the definition by FMAKUNBOUND.
;; - Since FMAKUNBOUND will remove all the methods on the generic function, make sure that
;; all the methods required for ASDF to successfully continue compiling itself
;; shall be defined in the same file as the one with the FMAKUNBOUND.
;; - When a function goes from DEFGENERIC to DEFUN, you MAY have to use FMAKUNBOUND, too.
;; Please try the upgrade tests on all supported implementations and update this comment afterwards.
;; shall be defined in the same file as the one with the FMAKUNBOUND, *after* the DEFGENERIC.
;; - When a function goes from DEFGENERIC to DEFUN, you may omit to use FMAKUNBOUND.
;; - For safety, you shall put the FMAKUNBOUND just before the DEFUN or DEFGENERIC,
;; in the same WITH-UPGRADABILITY form (and its implicit EVAL-WHEN).
;; - Any time you change a signature, please keep a comment specifying the first release after the change;
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment