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
asdf
asdf
Commits
c54a6e37
Commit
c54a6e37
authored
Jun 04, 2021
by
Robert Goldman
Browse files
Merge branch 'fix-find-definition' into 'master'
Simplify WITH-UPGRADABILITY See merge request
!142
parents
1c997636
7b4a25ca
Pipeline
#4034
canceled with stage
Changes
18
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
action.lisp
View file @
c54a6e37
...
...
@@ -132,7 +132,7 @@ Use it in FORMAT control strings as ~/asdf-action:format-action/"
;;;; Detection of circular dependencies
(
with-upgradability
()
(
defun
(
action-valid-p
)
(
operation
component
)
(
defun
action-valid-p
(
operation
component
)
"Is this action valid to include amongst dependencies?"
;; If either the operation or component was resolved to nil, the action is invalid.
;; :if-feature will invalidate actions on components for which the features don't apply.
...
...
doc/Changelog
View file @
c54a6e37
...
...
@@ -19,6 +19,8 @@ cl-asdf (2:3.3.5-1) unstable; urgency=low IN PROGRESS
* Fixes for feature handling from Eric Timmons.
* Replaced some of the internals of `parse-defsystem` with generic functions to
enable modular extension. Thanks to Eric Timmons.
* Faré provided more graceful upgrade capabilities, fixing bugs with upgrading
support for local package nicknames, and with upgrading ABCL.
cl-asdf (2:3.3.4-1) unstable; urgency=low
Bug fix release:
...
...
gitlab-pipelines/standard-pipeline.yml
View file @
c54a6e37
...
...
@@ -116,13 +116,16 @@ Upgrade test:
-
l
:
[
abcl
,
ccl
,
clasp
,
clisp
,
cmucl
,
ecl
,
sbcl
]
IMAGE_TAG
:
latest
Upgrade test known failure
:
extends
:
.Upgrade test template
parallel
:
matrix
:
-
l
:
[
abcl
]
IMAGE_TAG
:
latest
allow_failure
:
true
# No more tests are known to fail. But leave commented out in case it needs to
# be resurrected.
# Upgrade test known failure:
# extends: .Upgrade test template
# parallel:
# matrix:
# - l: []
# IMAGE_TAG: latest
# allow_failure: true
.REQUIRE upgrade test template
:
extends
:
.Upgrade test template
...
...
@@ -137,15 +140,18 @@ REQUIRE upgrade test:
ASDF_UPGRADE_TEST_TAGS
:
REQUIRE
parallel
:
matrix
:
-
l
:
[
ccl
,
clasp
,
clisp
,
cmucl
,
ecl
,
sbcl
]
-
l
:
[
abcl
,
ccl
,
clasp
,
clisp
,
cmucl
,
ecl
,
sbcl
]
IMAGE_TAG
:
latest
REQUIRE upgrade test known failure
:
extends
:
.REQUIRE upgrade test template
variables
:
ASDF_UPGRADE_TEST_TAGS
:
REQUIRE
parallel
:
matrix
:
-
l
:
abcl
IMAGE_TAG
:
latest
allow_failure
:
true
# No more tests are known to fail. But leave commented out in case it needs to
# be resurrected.
# REQUIRE upgrade test known failure:
# extends: .REQUIRE upgrade test template
# variables:
# ASDF_UPGRADE_TEST_TAGS: REQUIRE
# parallel:
# matrix:
# - l: []
# IMAGE_TAG: latest
# allow_failure: true
output-translations.lisp
View file @
c54a6e37
...
...
@@ -194,7 +194,7 @@ and the order is by decreasing length of namestring of the source pathname.")
(
when
inherit
(
process-output-translations
(
first
inherit
)
:collect
collect
:inherit
(
rest
inherit
))))
(
defun
*
(
process-output-translations-directive
)
(
directive
&key
inherit
collect
)
(
defun
process-output-translations-directive
(
directive
&key
inherit
collect
)
(
if
(
atom
directive
)
(
ecase
directive
((
:enable-user-cache
)
...
...
@@ -287,7 +287,7 @@ effectively disabling the output translation facility."
;; Top-level entry-point to _use_ output-translations
(
defun
*
(
apply-output-translations
)
(
path
)
(
defun
apply-output-translations
(
path
)
(
etypecase
path
(
logical-pathname
path
)
...
...
parse-defsystem.lisp
View file @
c54a6e37
...
...
@@ -148,7 +148,8 @@ Please only define ~S and secondary systems with a name starting with ~S (e.g. ~
;; Given a form used as :version specification, in the context of a system definition
;; in a file at PATHNAME, for given COMPONENT with given PARENT, normalize the form
;; to an acceptable ASDF-format version.
(
defun*
(
normalize-version
)
(
form
&key
pathname
component
parent
)
(
fmakunbound
'normalize-version
)
;; signature changed between 2.27 and 2.31
(
defun
normalize-version
(
form
&key
pathname
component
parent
)
(
labels
((
invalid
(
&optional
(
continuation
"using NIL instead"
))
(
warn
(
compatfmt
"~@<Invalid :version specifier ~S~@[ for component ~S~]~@[ in ~S~]~@[ from file ~S~]~@[, ~A~]~@:>"
)
form
component
parent
pathname
continuation
))
...
...
@@ -293,11 +294,11 @@ COMPONENTS is a list of the explicitly defined children descriptions.
SERIAL-P is non-NIL if each child in COMPONENTS should depend on the previous
children."
))
(
defun
*
stable-union
(
s1
s2
&key
(
test
#'
eql
)
(
key
'identity
))
(
defun
stable-union
(
s1
s2
&key
(
test
#'
eql
)
(
key
'identity
))
(
append
s1
(
remove-if
#'
(
lambda
(
e2
)
(
member
(
funcall
key
e2
)
(
funcall
key
s1
)
:test
test
))
s2
)))
(
defun
*
(
parse-component-form
)
(
parent
options
&key
previous-serial-components
)
(
defun
parse-component-form
(
parent
options
&key
previous-serial-components
)
(
destructuring-bind
(
type
name
&rest
rest
&key
(
builtin-system-p
()
bspp
)
...
...
plan.lisp
View file @
c54a6e37
...
...
@@ -224,7 +224,7 @@ to be meaningful, or could it just as well have been done in another Lisp image?
;;;; Visiting dependencies of an action and computing action stamps
(
with-upgradability
()
(
defun
*
(
map-direct-dependencies
)
(
operation
component
fun
)
(
defun
map-direct-dependencies
(
operation
component
fun
)
"Call FUN on all the valid dependencies of the given action in the given plan"
(
loop
:for
(
dep-o-spec
.
dep-c-specs
)
:in
(
component-depends-on
operation
component
)
:for
dep-o
=
(
find-operation
operation
dep-o-spec
)
...
...
@@ -234,7 +234,7 @@ to be meaningful, or could it just as well have been done in another Lisp image?
:when
(
action-valid-p
dep-o
dep-c
)
:do
(
funcall
fun
dep-o
dep-c
))))
(
defun
*
(
reduce-direct-dependencies
)
(
operation
component
combinator
seed
)
(
defun
reduce-direct-dependencies
(
operation
component
combinator
seed
)
"Reduce the direct dependencies to a value computed by iteratively calling COMBINATOR
for each dependency action on the dependency's operation and component and an accumulator
initialized with SEED."
...
...
@@ -243,7 +243,7 @@ initialized with SEED."
#'
(
lambda
(
dep-o
dep-c
)
(
setf
seed
(
funcall
combinator
dep-o
dep-c
seed
))))
seed
)
(
defun
*
(
direct-dependencies
)
(
operation
component
)
(
defun
direct-dependencies
(
operation
component
)
"Compute a list of the direct dependencies of the action within the plan"
(
reverse
(
reduce-direct-dependencies
operation
component
#'
acons
nil
)))
...
...
@@ -527,7 +527,7 @@ Update the VISITED-ACTIONS table with the known status, but don't add anything t
:do
(
collect-action-dependencies
plan
(
action-operation
action
)
(
action-component
action
)))
(
plan-actions
plan
)))
(
defun
*
(
required-components
)
(
system
&rest
keys
&key
(
goal-operation
'load-op
)
&allow-other-keys
)
(
defun
required-components
(
system
&rest
keys
&key
(
goal-operation
'load-op
)
&allow-other-keys
)
"Given a SYSTEM and a GOAL-OPERATION (default LOAD-OP), traverse the dependencies and
return a list of the components involved in building the desired action."
(
with-asdf-session
(
:override
t
)
...
...
source-registry.lisp
View file @
c54a6e37
...
...
@@ -233,11 +233,11 @@ after having found a .asd file? True by default.")
(
defgeneric
process-source-registry
(
spec
&key
inherit
register
))
(
defun
*
(
inherit-source-registry
)
(
inherit
&key
register
)
(
defun
inherit-source-registry
(
inherit
&key
register
)
(
when
inherit
(
process-source-registry
(
first
inherit
)
:register
register
:inherit
(
rest
inherit
))))
(
defun
*
(
process-source-registry-directive
)
(
directive
&key
inherit
register
)
(
defun
process-source-registry-directive
(
directive
&key
inherit
register
)
(
destructuring-bind
(
kw
&rest
rest
)
(
if
(
consp
directive
)
directive
(
list
directive
))
(
ecase
kw
((
:include
)
...
...
system.lisp
View file @
c54a6e37
...
...
@@ -186,10 +186,11 @@ the primary one."
(
slot-value
(
find-system
(
primary-system-name
system
))
slot-name
))))
(
defmacro
define-system-virtual-slot-reader
(
slot-name
)
`
(
defun*
,
(
intern
(
concatenate
'string
(
string
:system-
)
(
string
slot-name
)))
(
system
)
(
system-virtual-slot-value
system
',slot-name
)))
(
let
((
name
(
intern
(
strcat
(
string
:system-
)
(
string
slot-name
)))))
`
(
progn
(
fmakunbound
',name
)
;; These were gf from defgeneric before 3.3.2.11
(
declaim
(
notinline
,
name
))
(
defun
,
name
(
system
)
(
system-virtual-slot-value
system
',slot-name
)))))
(
defmacro
define-system-virtual-slot-readers
()
`
(
progn
,@
(
mapcar
(
lambda
(
slot-name
)
`
(
define-system-virtual-slot-reader
,
slot-name
))
...
...
@@ -214,7 +215,7 @@ the primary one."
in which the system specification (.asd file) is located."
(
pathname-directory-pathname
(
system-source-file
system-designator
)))
(
defun
*
(
system-relative-pathname
)
(
system
name
&key
type
)
(
defun
system-relative-pathname
(
system
name
&key
type
)
"Given a SYSTEM, and a (Unix-style relative path) NAME of a file (or directory) of given TYPE,
return the absolute pathname of a corresponding file under that system's source code pathname."
(
subpathname
(
system-source-directory
system
)
name
:type
type
))
...
...
test/run-tests.sh
View file @
c54a6e37
...
...
@@ -434,33 +434,36 @@ extract_all_tagged_asdf () {
}
valid_upgrade_test_p
()
{
case
"
${
1
}
:
${
2
}
:
${
3
}
"
in
# It's damn slow. Also, for some reason, we punt on anything earlier than 2.25,
# and only need to test it once, below for 2.24.
abcl:1.
*
|
abcl:2.00[0-9]:
*
|
abcl:201[0-9]:
*
|
abcl:2.2[0-3]:
*
)
:
;;
# ccl fasl numbering broke loading of old asdf 2.0
ccl:2.0[01]
*
|
ccl:2.2[0-6]
*
)
:
;;
# It's damn slow. Also, we punt on anything 2.26 or earlier.
abcl:1.
*
|
abcl:2.[01]
*
|
abcl:2.2[0-5]:
*
)
:
;;
# Allegro ships with versions 3*, so give up testing 2
# Also, unpatched Allegro 10 has bug updating from 2.26 and before
allegro
*
:[12].
*
)
:
;;
# My old ubuntu 10.04LTS clisp 2.44.1 came wired in
# ccl fasl numbering broke loading of old asdf 2.0. 2.27 has trouble with deferred-warnings.
ccl:2.[01]
*
|
ccl:2.2[0-7]
*
)
:
;;
# clasp only since 3.1.4.3
clasp:2.
*
|
clasp:3.0
*
|
clasp:3.1.[0-4]
*
)
:
;;
# CLISP: My old ubuntu 10.04LTS clisp 2.44.1 came wired in
# with an antique ASDF 1.374 from CLC that can't be downgraded.
# More recent CLISPs work.
# 2.00[0-7] use UID, which fails on some old CLISPs.
# Note that for the longest time, CLISP has included 2.011 in its
distribution
.
# Now its hg repository includes 3.
0.2.29
, but clisp hasn't released in many years(!)
# Note that for the longest time, CLISP has included 2.011 in its
source repository
.
# Now its hg repository includes 3.
x
, but clisp hasn't released in many years(!)
# We don't punt on upgrade anymore, so we can go at it!
#clisp:2.00[0-7]:*|clisp:1.*|clisp:2.0[01]*|clisp:2.2[0-5]:*) : ;;
# CMUCL has problems with
2.32
and earlier because of
# CMUCL has problems with
3.2.1
and earlier because of
# the redefinition of system's superclass component.
cmucl:1.
*
|
cmucl:2.
[012]
*
|
cmucl:
2.
3[012]
*
)
:
;;
cmucl:1.
*
|
cmucl:2.
*
|
cmucl:3
.
[012]
*
)
:
;;
# Skip many ECL tests, for various ASDF issues
ecl
*
:1.
*
|
ecl
*
:2.0[01]
*
|
ecl
*
:2.20:
*
)
:
;;
# GCL 2.7.0 from late November 2013 is required, with ASDF 3.1.2
gcl:REQUIRE:
*
|
gcl:1.
*
|
gcl:2.
*
|
gcl:3.0
*
)
:
;;
gcl:REQUIRE:
*
|
gcl:1.
*
|
gcl:2.
*
|
gcl:3.0
*
|
gcl:3.1.[0-3]
*
)
:
;;
# LispWorks is broken at ASDF 3.0.3, but can upgrade from earlier and later ASDFs.
lispworks:3.0.3:
*
)
:
;;
lispworks:1
*
|
lispworks:2.[0-2]
*
|
lispworks:2.3[0-2]
*
|
lispworks:3.0.3:
*
)
:
;;
# MKCL is only supported starting with specific versions 2.24, 2.26.x, 3.0.3.0.x, so skip.
mkcl:[12]
*
|
mkcl:3.0
*
)
:
;;
# SBCL won't run ASDF 1 anymore
sbcl:1
*
)
:
;;
# XCL support starts with ASDF 2.014.2
# — It also dies during upgrade trying to show the backtrace.
xcl:1.
*
|
xcl:2.00
*
|
xcl:2.01[0-4]:
*
|
xcl:
*
)
:
;;
...
...
test/test-package-local-nicknames.script
View file @
c54a6e37
...
...
@@ -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
))
...
...
tools/test-upgrade.lisp
View file @
c54a6e37
...
...
@@ -16,7 +16,10 @@
;; The 3.3 series provides the asdf3.3 feature, meaning users can rely on
;; all its new features (proper phase separation) as well as earlier features.
"3.3.1"
;; (2017-11-14) bug fixes, second and latest in 3.3 series
"3.3.4"
;; (2020-02-14) bug fixes, fifth and latest in 3.3 series
"3.3.3"
;; (2019-03-27) bug fixes, fourth in 3.3 series
"3.3.2"
;; (2018-05-04) bug fixes, third in 3.3 series
"3.3.1"
;; (2017-11-14) bug fixes, second in 3.3 series, SBCL has been stuck there for years
"3.3.0"
;; (2017-10-06) first in 3.3 series
;; The 3.2 series provides the asdf3.2 feature, meaning users can rely on
...
...
@@ -133,9 +136,10 @@ Use at a given tag, put it under build/asdf-${tag}.lisp"
:allegro_64_s
:allegromodern_64_s
:allegro8_64_s
:allegromodern8_64_s
)
(
version<=
"2.27"
tag
))
;; CCL fasl numbering broke loading of old asdf 2.0, and the punting for 2.26 fails,
;; but who cares since CCL has always been shipping recent versions of ASDF.
((
:ccl
)
(
version<=
"2.27"
tag
))
;; CCL fasl numbering broke loading of old asdf 2.0, the punting for 2.26 fails, and
;; 2.27 enables deferred-warnings then the new UIOP causes confusion with its changed format.
;; But who cares since CCL has always been shipping recent versions of ASDF.
((
:ccl
)
(
version<=
"2.32"
tag
))
;; CLASP is only supported as of 3.1.4.3
((
:clasp
)
(
version<=
"3.1.4.3"
tag
))
...
...
@@ -149,9 +153,9 @@ Use at a given tag, put it under build/asdf-${tag}.lisp"
;; However, whether we punt or don't punt, these should all work.
((
:clisp
)
t
)
;; CMUCL has problems with
2.32
and earlier because of
;;
the redefinition of system's superclass componen
t.
((
:cmucl
)
(
version<=
"
2
.3
3
"
tag
))
;; CMUCL has problems with
3.2.1
and earlier because of
the redefinition of
;;
some classes that causes its subtype to answer NIL when it shouldn'
t.
((
:cmucl
)
(
version<=
"
3
.3
.0
"
tag
))
;; Skip many ECL tests, for various ASDF issues
((
:ecl
:ecl_bytecodes
)
(
version<=
"2.21"
tag
))
...
...
@@ -161,14 +165,20 @@ Use at a given tag, put it under build/asdf-${tag}.lisp"
;; against anything but the latest release.
((
:gcl
)
(
version<=
"3.1.4"
tag
))
;; LispWorks is fine, but ASDF 3.0.3 has a bug and can't be loaded.
((
:lispworks
)
(
not
(
equal
"3.0.3"
tag
)))
;; LispWorks is fine, but ASDF 3.0.3 can't be loaded due to a bug it has a bug,
;; while 2.27 to 2.32 use system:pid-exit-status that doesn't exist anymore in LispWorks 7.
((
:lispworks
)
(
and
(
version<=
"2.33"
tag
)
(
not
(
equal
"3.0.3"
tag
))))
;; MKCL is only supported starting with specific versions 2.24, 2.26.x, 3.0.3.0.x, so skip.
((
:mkcl
)
(
version<=
"3.1.2"
tag
))
;; The bundle support also changed a lot in 3.2.0 and this breaks upgrading from 3.1.
((
:mkcl
)
(
version<=
"3.2.0"
tag
))
;; all clear on these implementations
((
:sbcl
:scl
)
t
)
;; SBCL fails to load ASDF as a system 1.369 because ASDF 1.369's builtin
;; asdf-binary-locations gets confused when SBCL_HOME is not set by SBCL anymore.
((
:sbcl
)
(
version<=
"2.000"
tag
))
;; SCL is all good.
((
:scl
)
(
version<=
"2.000"
tag
))
;; XCL support starts with ASDF 2.014.2
;; — It also dies during upgrade trying to show the backtrace.
...
...
@@ -196,6 +206,7 @@ Use the preferred lisp implementation"
(
extract-tagged-asdf
tag
)
(
run-test-lisp
description
`
((
load
"test/script-support.lisp"
)
(
asdf-test::debug-asdf
)
(
asdf-test::test-upgrade
,@
method
,
tag
))
:lisp
lisp
:log
log
))
description
))
...
...
uiop/configuration.lisp
View file @
c54a6e37
...
...
@@ -215,7 +215,7 @@ directive.")
(
declaim
(
ftype
(
function
(
t
&key
(
:directory
boolean
)
(
:wilden
boolean
)
(
:ensure-directory
boolean
))
t
)
resolve-location
))
(
defun
*
(
resolve-location
)
(
x
&key
ensure-directory
wilden
directory
)
(
defun
resolve-location
(
x
&key
ensure-directory
wilden
directory
)
"Resolve location designator X into a PATHNAME"
;; :directory backward compatibility, until 2014-01-16: accept directory as well as ensure-directory
(
loop
:with
dirp
=
(
or
directory
ensure-directory
)
...
...
uiop/driver.lisp
View file @
c54a6e37
...
...
@@ -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/lisp-build.lisp
View file @
c54a6e37
...
...
@@ -662,7 +662,7 @@ possibly in a different process. Otherwise just call THUNK."
(
defvar
*compile-check*
nil
"A hook for user-defined compile-time invariants"
)
(
defun
*
(
compile-file*
)
(
input-file
&rest
keys
(
defun
compile-file*
(
input-file
&rest
keys
&key
(
compile-check
*compile-check*
)
output-file
warnings-file
#+
clisp
lib-file
#+
(
or
clasp
ecl
mkcl
)
object-file
#+
sbcl
emit-cfasl
&allow-other-keys
)
...
...
uiop/package.lisp
View file @
c54a6e37
...
...
@@ -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
)
...
...
@@ -605,13 +636,15 @@ or when loading the package is optional."
#+
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
))
(
dolist
(
pair-to-remove
(
uiop/package-local-nicknames:package-local-nicknames
destination-package
))
(
uiop/package-local-nicknames: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
)))
:do
(
uiop/package-local-nicknames:add-package-local-nickname
(
string
nickname
)
(
find-package
package
)
destination-package
)))
(
defun
ensure-package
(
name
&key
nicknames
documentation
use
...
...
@@ -664,7 +697,6 @@ or when loading the package is optional."
;; Handle local nicknames
#+
package-local-nicknames
(
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
...
...
@@ -818,3 +850,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/pathname.lisp
View file @
c54a6e37
...
...
@@ -715,7 +715,7 @@ added to its DIRECTORY component. This is useful for output translations."
:defaults
pathname
)))
pathname
)))
(
defun
*
(
translate-pathname*
)
(
path
absolute-source
destination
&optional
root
source
)
(
defun
translate-pathname*
(
path
absolute-source
destination
&optional
root
source
)
"A wrapper around TRANSLATE-PATHNAME to be used by the ASDF output-translations facility.
PATH is the pathname to be translated.
ABSOLUTE-SOURCE is an absolute pathname to use as source for translate-pathname,
...
...
uiop/utility.lisp
View file @
c54a6e37
...
...
@@ -12,7 +12,6 @@
;; magic helper to define debugging functions:
#:uiop-debug
#:load-uiop-debug-utility
#:*uiop-debug-utility*
#:with-upgradability
;; (un)defining functions in an upgrade-friendly way
#:defun*
#:defgeneric*
#:nest
#:if-let
;; basic flow control
#:parse-body
;; macro definition helper
#:while-collecting
#:appendf
#:length=n-p
#:ensure-list
;; lists
...
...
@@ -41,29 +40,33 @@
(
in-package
:uiop/utility
)
;;;; Defining functions in a way compatible with hot-upgrade:
;; DEFUN* and DEFGENERIC* use FMAKUNBOUND to delete any previous fdefinition,
;; thus replacing the function without warning or error
;; even if the signature and/or generic-ness of the function has changed.
;; For a generic function, this invalidates any previous DEFMETHOD.
;; - The WTIH-UPGRADABILITY infrastructure below ensures that functions are declared NOTINLINE,
;; 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,
;; 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.,
;; because the change other caused a huge incompatibility during upgrade.
;; - Whenever a function goes from a DEFUN to a DEFGENERIC, or the DEFGENERIC signature changes, etc.,
;; 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, *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;
;; put that comment on the same line as FMAKUNBOUND, it you use FMAKUNBOUND.