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
b4333763
Commit
b4333763
authored
Jan 28, 2013
by
Francois-Rene Rideau
Browse files
2.26.164: upgrade now works on ABCL! But still not on CLISP.
Also, move some functions from stream to filesystem where they belong.
parent
ac799f29
Changes
16
Hide whitespace changes
Inline
Side-by-side
TODO
View file @
b4333763
* Resolve performance degradation issue reported by stassats and fe[nl]ix
** Is it the warnings feature taking too much resources?
** Is output-files and/or input-files being called too much? Cache it!
* fix upgrade on
(abcl, clisp, cmucl)
* fix upgrade on
clisp
** Extract minimal test case
* Bug found by fe[nl]ix: infinite loop if the definitions in an asd file
are not in strict defsystem-depends-on dependency order. Document the issue.
...
...
asdf-driver.asd
View file @
b4333763
...
...
@@ -22,7 +22,7 @@ that you can't portably construct a complete program without using them."
(
:file
"common-lisp"
:depends-on
(
"package"
))
(
:file
"utility"
:depends-on
(
"common-lisp"
))
(
:file
"os"
:depends-on
(
"utility"
))
(
:file
"pathname"
:depends-on
(
"utility"
))
(
:file
"pathname"
:depends-on
(
"utility"
"os"
))
(
:file
"filesystem"
:depends-on
(
"os"
"pathname"
))
(
:file
"stream"
:depends-on
(
"filesystem"
))
(
:file
"image"
:depends-on
(
"stream"
))
...
...
asdf.asd
View file @
b4333763
...
...
@@ -66,7 +66,7 @@
:licence
"MIT"
:description
"Another System Definition Facility"
:long-description
"ASDF builds Common Lisp software organized into defined systems."
:version
"2.26.16
3
"
;; to be automatically updated by make bump-version
:version
"2.26.16
4
"
;; to be automatically updated by make bump-version
:depends-on
()
#+
asdf3
:encoding
#+
asdf3
:utf-8
;; For most purposes, asdf itself specially counts as a builtin system.
...
...
component.lisp
View file @
b4333763
...
...
@@ -182,7 +182,7 @@ another pathname in a degenerate way."))
(
compute-children-by-name
m
))))
(
defclass
module
(
child-component
parent-component
)
(
))
(
#+
clisp
(
components
)))
;; backward compatibility during upgrade only
;;;; component pathnames
...
...
filesystem.lisp
View file @
b4333763
...
...
@@ -19,7 +19,11 @@
#:inter-directory-separator
#:split-native-pathnames-string
#:getenv-pathname
#:getenv-pathnames
#:getenv-absolute-directory
#:getenv-absolute-directories
#:lisp-implementation-directory
#:lisp-implementation-pathname-p
))
#:lisp-implementation-directory
#:lisp-implementation-pathname-p
;; Simple filesystem operations
#:ensure-all-directories-exist
#:rename-file-overwriting-target
#:delete-file-if-exists
))
(
in-package
:asdf/filesystem
)
;;; Native namestrings, as seen by the operating system calls rather than Lisp
...
...
@@ -446,3 +450,19 @@ TRUENAMIZE uses TRUENAMIZE to resolve as many symlinks as possible."
t
))
;;; Simple filesystem operations
(
defun*
ensure-all-directories-exist
(
pathnames
)
(
dolist
(
pathname
pathnames
)
(
ensure-directories-exist
(
translate-logical-pathname
pathname
))))
(
defun*
rename-file-overwriting-target
(
source
target
)
#+
clisp
;; But for a bug in CLISP 2.48, we should use :if-exists :overwrite and be atomic
(
posix:copy-file
source
target
:method
:rename
)
#-
clisp
(
rename-file
source
target
#+
clozure
:if-exists
#+
clozure
:rename-and-delete
))
(
defun*
delete-file-if-exists
(
x
)
(
handler-case
(
delete-file
x
)
(
file-error
()
nil
)))
header.lisp
View file @
b4333763
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; This is ASDF 2.26.16
3
: Another System Definition Facility.
;;; This is ASDF 2.26.16
4
: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
...
...
@@ -54,7 +54,7 @@
(
declaim
(
optimize
(
speed
1
)
(
safety
3
)
(
debug
3
)))
(
setf
ext:*gc-verbose*
nil
))
#+
(
or
abcl
clisp
)
;; cmu
#+
clisp
(
eval-when
(
:load-toplevel
:compile-toplevel
:execute
)
(
unless
(
member
:asdf3
*features*
)
(
let*
((
existing-version
...
...
image.lisp
View file @
b4333763
...
...
@@ -89,6 +89,8 @@ This is designed to abstract away the implementation specific quit forms."
(
defun*
raw-print-backtrace
(
&key
(
stream
*debug-io*
)
count
)
"Print a backtrace, directly accessing the implementation"
(
declare
(
ignorable
stream
count
))
#+
abcl
(
let
((
*debug-io*
stream
))
(
top-level::backtrace-command
count
))
#+
allegro
(
let
((
*terminal-io*
stream
)
(
*standard-output*
stream
)
...
...
lisp-action.lisp
View file @
b4333763
...
...
@@ -12,7 +12,7 @@
#:basic-load-op
#:basic-compile-op
#:compile-op-flags
#:compile-op-proclamations
#:load-op
#:prepare-op
#:compile-op
#:test-op
#:load-source-op
#:prepare-source-op
#:call-with-around-compile-hook
#:perform-lisp-compilation
#:perform-lisp-load-fasl
#:perform-lisp-load-source
))
#:perform-lisp-compilation
#:perform-lisp-load-fasl
#:perform-lisp-load-source
#:flags
))
(
in-package
:asdf/lisp-action
)
...
...
lisp-build.lisp
View file @
b4333763
...
...
@@ -4,7 +4,7 @@
(
asdf/package:define-package
:asdf/lisp-build
(
:recycle
:asdf/interface
:asdf
:asdf/lisp-build
)
(
:use
:asdf/common-lisp
:asdf/package
:asdf/utility
:asdf/pathname
:asdf/
strea
m
:asdf/
o
s
:asdf/image
)
:asdf/os
:asdf/pathname
:asdf/
filesyste
m
:asdf/s
tream
:asdf/image
)
(
:export
;; Variables
#:*compile-file-warnings-behaviour*
#:*compile-file-failure-behaviour*
...
...
pathname.lisp
View file @
b4333763
...
...
@@ -5,7 +5,7 @@
(
asdf/package:define-package
:asdf/pathname
(
:recycle
:asdf/pathname
:asdf
)
(
:use
:asdf/common-lisp
:asdf/package
:asdf/utility
)
(
:use
:asdf/common-lisp
:asdf/package
:asdf/utility
:asdf/os
)
(
:export
;; Making and merging pathnames, portably
#:normalize-pathname-directory-component
#:denormalize-pathname-directory-component
...
...
stream.lisp
View file @
b4333763
...
...
@@ -19,9 +19,7 @@
#:detect-encoding
#:*encoding-detection-hook*
#:always-default-encoding
#:encoding-external-format
#:*encoding-external-format-hook*
#:default-encoding-external-format
#:*default-encoding*
#:*utf-8-external-format*
#:ensure-all-directories-exist
#:rename-file-overwriting-target
#:delete-file-if-exists
;; Temporary files
#:*temporary-directory*
#:temporary-directory
#:default-temporary-directory
#:setup-temporary-directory
#:call-with-temporary-file
#:with-temporary-file
...
...
@@ -339,7 +337,7 @@ hopefully, if done consistently, that won't affect program behavior too much.")
"Hook for an extension to define a function to automatically detect a file's encoding"
)
(
defun*
detect-encoding
(
pathname
)
(
if
(
and
pathname
(
not
(
directory-pathname-p
pathname
))
(
probe-file
pathname
))
(
if
(
and
pathname
(
not
(
directory-pathname-p
pathname
))
(
probe-file
*
pathname
))
(
funcall
*encoding-detection-hook*
pathname
)
*default-encoding*
))
...
...
@@ -360,22 +358,6 @@ and implementation-defined external-format's")
(
funcall
*encoding-external-format-hook*
encoding
))
;;; Simple filesystem operations
(
defun*
ensure-all-directories-exist
(
pathnames
)
(
dolist
(
pathname
pathnames
)
(
ensure-directories-exist
(
translate-logical-pathname
pathname
))))
(
defun*
rename-file-overwriting-target
(
source
target
)
#+
clisp
;; But for a bug in CLISP 2.48, we should use :if-exists :overwrite and be atomic
(
posix:copy-file
source
target
:method
:rename
)
#-
clisp
(
rename-file
source
target
#+
clozure
:if-exists
#+
clozure
:rename-and-delete
))
(
defun*
delete-file-if-exists
(
x
)
(
handler-case
(
delete-file
x
)
(
file-error
()
nil
)))
;;; Using temporary files
(
defun*
default-temporary-directory
()
(
or
...
...
@@ -409,7 +391,7 @@ and implementation-defined external-format's")
:for
pathname
=
(
pathname
(
format
nil
"~A~36R"
prefix
counter
))
:do
;; TODO: on Unix, do something about umask
;; TODO: on Unix, audit the code so we make sure it uses O_CREAT|O_EXCL
;; TODO: on Unix, use CFFI and mkstemp -- but
the mast
er is precisely meant to not depend on CFFI or on anything! Grrrr.
;; TODO: on Unix, use CFFI and mkstemp -- but
asdf/driv
er is precisely meant to not depend on CFFI or on anything! Grrrr.
(
with-open-file
(
stream
pathname
:direction
direction
:element-type
element-type
...
...
test/run-tests.sh
View file @
b4333763
...
...
@@ -282,8 +282,8 @@ extract_tagged_asdf () {
}
valid_upgrade_test_p
()
{
case
"
${
1
}
:
${
2
}
:
${
3
}
"
in
abcl:
2.0[01][1
-9]:
*
|
abcl:2
.2[1-2
]:
*
)
: Skip, because it is so
damn
slow
;;
abcl:
1.
*
|
abcl:2.00[0
-9]:
*
|
abcl:2
01[0-7
]:
*
)
:
"
Skip, because it is so slow
."
;;
ccl:1.
*
|
ccl:2.0[01]
*
)
: Skip, because ccl broke old asdf
;;
clisp:1.??
*
|
clisp:2.00[0-7]:
*
)
...
...
test/script-support.lisp
View file @
b4333763
...
...
@@ -430,9 +430,9 @@ is bound, write a message and exit on an error. If
(
cons
(
format
nil
"~{~D~^.~}"
ver
))
(
null
"1.0"
))))))
(
defun
test-upgrade
(
old-method
new-method
tag
)
;; called by run-test
(
with-test
()
(
verbose
t
nil
)
(
when
old-method
(
cond
((
string-equal
tag
"REQUIRE"
)
...
...
@@ -444,6 +444,8 @@ is bound, write a message and exit on an error. If
(
t
(
format
t
"Loading old asdf ~A via ~A~%"
tag
old-method
)
(
funcall
old-method
tag
))))
(
setf
(
asymval
:*asdf-verbose*
)
t
)
(
setf
(
asymval
:*verbose-out*
)
*standard-output*
)
(
format
t
"Now loading new asdf via method ~A~%"
new-method
)
(
funcall
new-method
)
(
format
t
"Testing it~%"
)
...
...
upgrade.lisp
View file @
b4333763
...
...
@@ -54,15 +54,22 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO
;; "3.4.5.67" would be a development version in the official upstream 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
"2.26.16
3
"
)
(
asdf-version
"2.26.16
4
"
)
(
existing-version
(
asdf-version
)))
(
setf
*asdf-version*
asdf-version
)
(
when
(
and
existing-version
(
not
(
equal
asdf-version
existing-version
)))
(
push
existing-version
*previous-asdf-versions*
)
(
when
*asdf-verbose*
(
format
*trace-output*
(
compatfmt
"~&~@<; ~@;Upgrading ASDF ~@[from version ~A ~]to version ~A~@:>~%"
)
existing-version
asdf-version
)))
(
setf
*asdf-version*
asdf-version
)))
existing-version
asdf-version
))
;; Punt when upgrading from too old a version of ASDF
#+
(
or
abcl
clisp
cmu
)
(
when
(
version<
existing-version
#+
abcl
"2.25"
#+
cmu
"2.018"
#+
clisp
"2.27"
)
(
let
((
away
(
format
nil
"~A-~A"
:asdf
existing-version
)))
(
rename-package
:asdf
away
)
(
when
(
or
*load-verbose*
*asdf-verbose*
)
(
format
*trace-output*
"; Renamed package ~A away to ~A~%"
:asdf
away
)))))))
(
when-upgrading
()
(
let
((
redefined-functions
;; gf signature and/or semantics changed incompatibly. Oops.
...
...
@@ -87,12 +94,12 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO
#:resolve-relative-location-component
#:resolve-absolute-location-component
#:output-files-for-system-and-operation
)))
; obsolete ASDF-BINARY-LOCATION function
(
declare
(
ignorable
redefined-functions
uninterned-symbols
))
(
loop
:for
name
:in
(
append
#-
(
or
clisp
ecl
)
redefined-functions
)
(
loop
:for
name
:in
(
append
#-
(
or
ecl
)
redefined-functions
)
:for
sym
=
(
find-symbol*
name
:asdf
nil
)
:do
(
when
sym
(
fmakunbound
sym
)))
(
loop
:with
asdf
=
(
find-package
:asdf
)
:for
name
:in
(
append
#+
(
or
clisp
ecl
)
redefined-functions
uninterned-symbols
)
;XXX
:for
name
:in
(
append
#+
(
or
ecl
)
redefined-functions
uninterned-symbols
)
;XXX
:for
sym
=
(
find-symbol*
name
:asdf
nil
)
:for
base-pkg
=
(
and
sym
(
symbol-package
sym
))
:do
(
when
sym
...
...
utility.lisp
View file @
b4333763
...
...
@@ -28,7 +28,8 @@
#:match-condition-p
#:match-any-condition-p
;; conditions
#:call-with-muffled-conditions
#:with-muffled-conditions
#:load-string
#:load-stream
#:parse-version
#:unparse-version
#:version-compatible-p
))
;; version
#:lexicographic<
#:lexicographic<=
#:parse-version
#:unparse-version
#:version<
#:version<=
#:version-compatible-p
))
;; version
(
in-package
:asdf/utility
)
;;;; Defining functions in a way compatible with hot-upgrade:
...
...
@@ -314,6 +315,7 @@ instead of a list."
;;; Version handling
(
eval-when
(
:compile-toplevel
:load-toplevel
:execute
)
(
defun*
unparse-version
(
version-list
)
(
format
nil
"~{~D~^.~}"
version-list
))
...
...
@@ -344,6 +346,23 @@ in that it doesn't print back to itself, but the list is returned anyway."
(
call-function
on-error
"~S: ~S contains leading zeros"
'parse-version
version-string
))
version-list
)))
(
defun*
lexicographic<
(
<
x
y
)
(
cond
((
null
y
)
nil
)
((
null
x
)
t
)
((
funcall
<
(
car
x
)
(
car
y
))
t
)
((
funcall
<
(
car
y
)
(
car
x
))
nil
)
(
t
(
lexicographic<
<
(
cdr
x
)
(
cdr
y
)))))
(
defun*
lexicographic<=
(
<
x
y
)
(
not
(
lexicographic<
<
y
x
)))
(
defun*
version<
(
version1
version2
)
(
let
((
v1
(
parse-version
version1
nil
))
(
v2
(
parse-version
version2
nil
)))
(
lexicographic<
'<
v1
v2
)))
(
defun*
version<=
(
version1
version2
)
(
not
(
version<
version2
version1
)))
(
defun*
version-compatible-p
(
provided-version
required-version
)
"Is the provided version a compatible substitution for the required-version?
...
...
@@ -352,14 +371,8 @@ If they are equal, then any later version is compatible,
with later being determined by a lexicographical comparison of minor numbers."
(
let
((
x
(
parse-version
provided-version
nil
))
(
y
(
parse-version
required-version
nil
)))
(
labels
((
bigger
(
x
y
)
(
cond
((
not
y
)
t
)
((
not
x
)
nil
)
((
>
(
car
x
)
(
car
y
))
t
)
((
=
(
car
x
)
(
car
y
))
(
bigger
(
cdr
x
)
(
cdr
y
))))))
(
and
x
y
(
=
(
car
x
)
(
car
y
))
(
or
(
not
(
cdr
y
))
(
bigger
(
cdr
x
)
(
cdr
y
)))))))
(
and
x
y
(
=
(
car
x
)
(
car
y
))
(
lexicographic<=
'<
(
cdr
y
)
(
cdr
x
)))))
)
; eval-when for version support
;;; Condition control
...
...
version.lisp-expr
View file @
b4333763
"2.26.16
3
"
"2.26.16
4
"
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