Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
A
asdf
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
16
Issues
16
List
Boards
Labels
Service Desk
Milestones
Merge Requests
8
Merge Requests
8
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
asdf
asdf
Commits
61c470b1
Commit
61c470b1
authored
May 20, 2014
by
Francois-Rene Rideau
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Add help, flesh out release function.
parent
80096b73
Changes
9
Hide whitespace changes
Inline
Side-by-side
Showing
9 changed files
with
151 additions
and
69 deletions
+151
-69
tools/asdf-tools.asd
tools/asdf-tools.asd
+3
-2
tools/git.lisp
tools/git.lisp
+8
-3
tools/main.lisp
tools/main.lisp
+54
-5
tools/package.lisp
tools/package.lisp
+3
-1
tools/release.lisp
tools/release.lisp
+43
-28
tools/test-all.lisp
tools/test-all.lisp
+9
-9
tools/test-environment.lisp
tools/test-environment.lisp
+15
-13
tools/test-upgrade.lisp
tools/test-upgrade.lisp
+1
-0
tools/version.lisp
tools/version.lisp
+15
-8
No files found.
tools/asdf-tools.asd
View file @
61c470b1
...
...
@@ -3,18 +3,19 @@
:depends-on
((
:version
"asdf"
"3.1.2"
)
(
:version
"inferior-shell"
"2.0.0"
)
(
:version
"cl-ppcre"
"2.0.4"
)
(
:version
"lisp-invocation"
"1.0.2"
))
(
:version
"lisp-invocation"
"1.0.2"
)
(
:feature
:sbcl
"sb-introspect"
))
:components
((
:file
"package"
)
(
:file
"pathnames"
:depends-on
(
"package"
))
(
:file
"git"
:depends-on
(
"package"
))
(
:file
"build"
:depends-on
(
"pathnames"
))
(
:file
"version"
:depends-on
(
"pathnames"
))
(
:file
"release"
:depends-on
(
"version"
))
(
:file
"invoke-lisp"
:depends-on
(
"package"
))
(
:file
"test-environment"
:depends-on
(
"pathnames"
"invoke-lisp"
))
(
:file
"test-basic"
:depends-on
(
"test-environment"
))
(
:file
"test-scripts"
:depends-on
(
"test-environment"
))
(
:file
"test-upgrade"
:depends-on
(
"test-environment"
"git"
))
(
:file
"test-all"
:depends-on
(
"test-environment"
))
(
:file
"release"
:depends-on
(
"version"
"test-environment"
))
(
:file
"main"
:depends-on
(
"package"
))))
tools/git.lisp
View file @
61c470b1
...
...
@@ -4,13 +4,18 @@
;; Note that the debian git at git://git.debian.org/git/pkg-common-lisp/cl-asdf.git is stale,
;; as we currently build directly from upstream at git://common-lisp.net/projects/asdf/asdf.git
(
defun
git
(
cmd
&rest
args
)
(
defun
run*
(
cmd
&rest
keys
)
(
multiple-value-bind
(
out
err
code
)
(
apply
'run
cmd
keys
)
(
values
(
eql
0
code
)
out
err
code
)))
(
defun
git
(
cmd
&rest
keys
)
(
with-asdf-dir
()
(
apply
'run
(
cons
"git"
cmd
)
arg
s
)))
(
apply
'run
*
(
cons
"git"
cmd
)
key
s
)))
(
defun
clean
()
(
git
'
(
clean
-xfd
))
(
values
)
)
t
)
(
defun
%push
()
"Push git branches master and release to cl.net and master"
...
...
tools/main.lisp
View file @
61c470b1
...
...
@@ -3,20 +3,69 @@
(
in-package
:asdf-tools
)
(
defun
re
(
arg
)
;;; Read-Eval function (the RE of REPL; the Print and Loop parts are not here)
"Read-Eval function (the RE of REPL; the Print and Loop parts are not here)"
(
eval
(
read-from-string
arg
)))
(
defun
find-command
(
x
)
"Find the function for an asdf-
builder
command by name"
"Find the function for an asdf-
tools
command by name"
(
block
nil
(
flet
((
try
(
x
)
(
multiple-value-bind
(
sym
foundp
)
(
find-symbol*
(
string-upcase
x
)
:asdf-tools
nil
)
(
when
(
and
sym
(
eq
foundp
:internal
)
(
fboundp
sym
))
(
return
(
fdefinition
sym
)
)))))
(
try
(
strcat
"%"
x
))
;; so that you may use load, t, etc., as targets
(
when
(
and
sym
foundp
(
fboundp
sym
))
(
return
sym
)))))
(
try
(
strcat
"%"
(
string
x
)
))
;; so that you may use load, t, etc., as targets
(
try
x
))))
(
defun
command-name
(
x
)
(
let
((
c
(
find-command
x
)))
(
when
c
(
let
((
s
(
string-downcase
c
)))
(
if
(
eql
(
first-char
s
)
#\%
)
(
subseq
s
1
)
s
)))))
(
defun
short-function-description
(
x
)
"Short function description for x"
(
when
(
stringp
x
)
(
setf
x
(
find-command
x
)))
(
if-let
((
doc
(
and
x
(
documentation
x
'function
))))
(
let*
((
first-line
(
with-input
(
s
doc
)
(
read-line
s
)))
(
len
(
length
first-line
)))
(
if
(
>=
len
50
)
(
strcat
(
subseq
first-line
0
49
)
"…"
)
first-line
))))
(
defun
find-commands
()
;;(loop :for x :being :the :external-symbols :of :asdf-tools
;; :when (and (eq x (find-command x)) (documentation x 'function)) :collect x)
'
(
build-asdf
doc
website
wc
;; build
clean
%push
merge-master-into-release
fix-local-git-tags
fix-remote-git-tags
;; git
git-all-committed-p
bump-version
bump
;; version
test-load-systems
test-clean-load
test-basic
%load
install-asdf
;; test-basic
%test
%t
test-scripts
;; test-scripts
test-upgrade
u
extract-tagged-asdf
extract-all-tagged-asdf
extract
;; test-upgrade
test-all-clean-load
test-all-lisp
test-all-no-upgrade
test-all-upgrade
;; test-all
test-all-scripts
test-all
test-all-scripts-no-stop
test-all-upgrade-no-stop
test-all-no-upgrade-no-stop
test-all-no-stop
check-all-scripts-results
check-all-upgrade-results
check-all-results
driver-files
asdf-defsystem-files
;; release
make-archive
publish-archive
link-archive
archive
install
debian-package
debian-architecture
publish-debian-package
re
help
))
;; main
(
defun
help
(
&optional
x
)
"List available commands, or the docstring of a given command"
(
cond
((
null
x
)
(
loop
:for
x
:in
(
sort
(
find-commands
)
'string<
:key
'find-command
)
:do
(
format
t
"~(~27A~)~@[ ~A~]~%"
(
command-name
x
)
(
short-function-description
x
))))
(
t
(
let
((
x
(
find-command
x
)))
(
when
x
(
format
t
"~A~@[ ~A~]~%~@[~A~]~&"
(
command-name
x
)
(
or
())
;; TODO: remember the arguments to deftestcmd, translate to v=, etc
(
documentation
x
'function
)))))))
;;; Main entry point.
;;; NB: For access control, you could check that only exported symbols are used as entry points.
(
defun
main
(
args
)
...
...
tools/package.lisp
View file @
61c470b1
(
defpackage
:asdf-tools
(
:use
:common-lisp
:uiop
:asdf
:fare-utils
:inferior-shell
:lisp-invocation
:cl-ppcre
))
(
:use
:common-lisp
:uiop
:asdf
:fare-utils
:inferior-shell
:lisp-invocation
:cl-ppcre
)
(
:export
))
;; TODO: export stuff
;; Just so we can use the name in our test scripts...
(
defpackage
:asdf-test
...
...
tools/release.lisp
View file @
61c470b1
...
...
@@ -88,7 +88,7 @@
(
with-asdf-dir
()
(
run
`
(
tar
zcf
(
"build/"
,
(
asdf-git-name
)
".tar.gz"
)
build/asdf.lisp
,@
(
run/lines
'
(
git
ls-files
))
(
asdf-git-name
))
:show
t
))
(
values
)
)
t
)
(
defun
asdf-lisp-name
()
(
format
nil
"asdf-~A.lisp"
*version*
))
...
...
@@ -103,7 +103,7 @@
(
make-asdf-defsystem-tarball
)
(
make-git-tarball
)
(
make-asdf-lisp
)
(
values
)
)
t
)
;;; Publishing tarballs onto the public repository
...
...
@@ -119,7 +119,7 @@
(
format
t
"~&To download the tarballs, point your browser at:~%
http://common-lisp.net/project/asdf/archives/
~%"
)
(
values
)
)
t
)
(
defun
link-archive
()
(
run
(
format
nil
"ln -sf ~S ~S ; ln -sf ~S ~S ; ln -sf ~S ~S ; ln -sf ~S ~S"
...
...
@@ -132,7 +132,7 @@
(
asdf-lisp-name
)
(
public-path
"archives/asdf.lisp"
))
:show
t
:host
*clnet*
)
(
values
)
)
t
)
(
defun
make-and-publish-archive
()
(
make-archive
)
...
...
@@ -147,10 +147,7 @@
(
defun
debian-package
(
&optional
(
release
"release"
))
(
let*
((
debian-version
(
debian-version-from-file
release
))
(
version
(
version-from-file
release
)))
(
unless
(
cl-ppcre:register-groups-bind
(
x
epoch
ver
rel
)
(
"^(([0-9]+):)?([0-9.]+)-([0-9]+)$"
debian-version
)
(
declare
(
ignorable
x
epoch
rel
))
(
equal
ver
version
))
(
unless
(
equal
version
(
parse-debian-version
debian-version
))
(
error
"Debian version ~A doesn't match asdf version ~A"
debian-version
version
))
(
clean
)
(
format
t
"building package version ~A~%"
(
debian-version-from-file
))
...
...
@@ -166,24 +163,42 @@
--git-ignore-branch
)
:directory
(
pn
)
:show
t
)))
(
defun
release
()
"Release the code (not implemented)"
#| RELEASE or PUSH checklist:
make test-all
make test-load-systems s=fare-all
make bump v=3.0
edit debian/changelog # RELEASE only...
git commit
git tag 3.0 # for example ...
make debian-package
git push
git push origin 3.0 # for example...
everything from here for RELEASE only
make release-push archive website debian-package
dput mentors ../*.changes
send debian mentors request
send announcement to asdf-announce, asdf-devel, etc.
Move all fixed bugs from Fix Committed -> Fix Released on launchpad
|#
(
die
42
"release is not implemented yet"
))
(
defun
debian-architecture
()
(
run/ss
`
(
dpkg
--print-architecture
)))
(
defun
publish-debian-package
(
&optional
release
)
(
let
((
changes
(
strcat
"cl-asdf_"
(
debian-version-from-file
release
)
"_"
(
debian-architecture
)
".changes"
)))
(
run*
`
(
dput
mentors
,
(
pn
"../"
changes
)))))
(
deftestcmd
release
(
new-version
lisps
scripts
systems
)
"Release the code (not implemented)"
(
break
)
;; for each function, offer to do it or not (?)
(
with-asdf-dir
()
(
let
((
log
(
newlogfile
"release"
"all"
))
(
releasep
(
=
(
length
(
parse-version
new-version
))
3
)))
(
when
releasep
(
let
((
debian-version
(
debian-version-from-file
)))
(
unless
(
equal
new-version
(
parse-debian-version
debian-version
))
(
error
"You're trying to release version ~A but the debian/changelog wasn't properly updated"
new-version
)))
(
when
(
nth-value
1
(
run
'
(
parse-changelog
debian/changelog
)
:output
nil
:error-output
:lines
))
(
error
"Malformed debian/changelog entry"
)))
(
and
;; need a better combinator, that tells us about progress, etc.
(
git-all-committed-p
)
(
test-all-no-stop
)
;; NEED ARGUMENTS!
(
test-load-systems
lisps
systems
)
(
bump
new-version
)
(
when
releasep
(
and
(
debian-package
)
(
publish-debian-package
)
(
merge-master-into-release
)))
;; SUCCESS! now publish more widely
(
%push
)
(
archive
)
(
website
)
(
when
releasep
(
log!
log
t
"Don't forget to send a debian mentors request!"
))
(
log!
log
"Don't forget to send announcement to asdf-announce, asdf-devel, etc."
)
(
log!
log
"Don't forget to move all fixed bugs from Fix Committed -> Fix Released on launchpad"
)))))
tools/test-all.lisp
View file @
61c470b1
...
...
@@ -24,12 +24,12 @@
"test that all lisp implementations pass all asdf upgrade tests"
(
with-all-lisps
(
*upgrade-test-lisps*
)
(
test-upgrade
)))
(
deftestcmd
test-all-
lisp
s
()
(
deftestcmd
test-all-
script
s
()
"test that all lisp implementations pass all asdf tests"
(
all-pass
(
test-all-no-upgrade
)
(
test-all-upgrade
)))
(
defalias
test-all
test-all-
lisp
s
)
(
defalias
test-all
test-all-
script
s
)
(
deftestcmd
test-all-
lisp
-no-stop
()
(
deftestcmd
test-all-
scripts
-no-stop
()
"test that all lisp implementations pass all asdf test scripts, but don't stop on error"
(
with-all-lisps
()
(
ignore-errors
(
test-scripts
))))
...
...
@@ -44,19 +44,19 @@
(
all-pass
(
test-basic
)
(
test-all-clean-load
)
(
test-all-
lisp
-no-stop
)
(
check-all-
test
-results
)))
(
test-all-
scripts
-no-stop
)
(
check-all-
scripts
-results
)))
(
deftestcmd
test-all-no-stop
()
(
deftestcmd
test-all-no-stop
()
;; TODO: pass arguments!
"test that all lisp implementations pass all asdf tests (including upgrade), but don't stop on error."
(
all-pass
(
test-basic
)
(
test-all-clean-load
)
(
test-all-
lisp
-no-stop
)
(
test-all-
scripts
-no-stop
)
(
test-all-upgrade-no-stop
)
(
check-all-results
)))
(
deftestcmd
check-all-
test
-results
()
(
deftestcmd
check-all-
scripts
-results
()
"were there errors in test scripts?"
(
with-asdf-dir
()
(
let
((
a
(
run/lines
...
...
@@ -82,5 +82,5 @@
(
deftestcmd
check-all-results
()
"check that there were no errors in either test scripts or upgrade tests"
(
all-pass
(
check-all-
test
-results
)
(
check-all-upgrade-results
)))
(
all-pass
(
check-all-
scripts
-results
)
(
check-all-upgrade-results
)))
tools/test-environment.lisp
View file @
61c470b1
...
...
@@ -107,7 +107,9 @@
(
upgrade-tags
((
upgrade-tags
*upgrade-test-tags*
))
(
setf
upgrade-tags
(
get-upgrade-tags
upgrade-tags
)))
(
upgrade-methods
((
upgrade-methods
*upgrade-test-methods*
))
(
setf
upgrade-methods
(
get-upgrade-methods
upgrade-methods
))))
(
setf
upgrade-methods
(
get-upgrade-methods
upgrade-methods
)))
(
new-version
(
new-version
)
(
setf
new-version
(
or
new-version
(
next-version
(
version-from-file
))))))
:for
arg
:in
args
:for
(
found
larg
init
)
=
(
assoc
arg
argmap
)
:append
(
if
found
larg
(
list
arg
))
:into
largs
...
...
@@ -157,7 +159,7 @@
(
if-let
(
date
(
safe-file-write-date
log
))
(
rename-file-overwriting-target
log
(
add-pathname-suffix
log
(
strcat
"-"
(
date-string
date
)))))
(
with-output-file
(
s
log
))
(
with-output-file
(
s
log
))
;; create the file
;;(format t "Logging results to ~A" log)
log
))
...
...
@@ -187,20 +189,20 @@
(
output
(
if
(
eq
output
t
)
*standard-output*
output
))
(
output
(
if
(
eq
output
*stdout*
)
:interactive
output
)))
(
log!
log
"~A"
(
print-process-spec
command
nil
))
(
multiple-value-bind
(
out
err
code
)
(
run
`
(
pipe
((
>&
2
1
)
,@
(
when
interactive
'
(
rlwrap
))
,@
command
)
,@
(
when
log
`
((
tee
-a
,
log
))))
:input
interactive
:output
output
:error-output
(
or
interactive
:output
)
:on-error
nil
)
(
multiple-value-bind
(
o
kp
o
ut
err
code
)
(
run
*
`
(
pipe
((
>&
2
1
)
,@
(
when
interactive
'
(
rlwrap
))
,@
command
)
,@
(
when
log
`
((
tee
-a
,
log
))))
:input
interactive
:output
output
:error-output
(
or
interactive
:output
)
:on-error
nil
)
(
unless
interactive
(
if
(
zerop
code
)
(
log!
log
"SUCCEEDED at ~A."
activity
)
(
log!
log
"FAILED at ~A.
(
log!
log
(
if
okp
"SUCCEEDED at ~A."
"FAILED at ~A.
You can retry ~A with:
~A
or more interactively, start with:
~A~%(rlwrap is optional; don't use it when in emacs; skip if not installed.)
then copy/paste:
~A"
activity
activity
(
print-process-spec
command
nil
)
(
interactive-command
)
(
compose-copy-paste-string
forms
)
)))
(
values
(
zerop
code
)
out
err
code
))))
~A"
)
activity
activity
(
print-process-spec
command
nil
)
(
interactive-command
)
(
compose-copy-paste-string
forms
)))
(
values
okp
out
err
code
))))
tools/test-upgrade.lisp
View file @
61c470b1
...
...
@@ -48,6 +48,7 @@
(
if
(
eq
x
:default
)
*default-upgrade-test-tags*
x
))
(
defun
extract-tagged-asdf
(
tag
)
"Extract an ASDF version at a given tag from git under build/asdf-${tag}.lisp"
(
with-asdf-dir
()
(
ensure-directories-exist
(
pn
"build/"
))
(
unless
(
string-equal
tag
"REQUIRE"
)
...
...
tools/version.lisp
View file @
61c470b1
...
...
@@ -21,6 +21,14 @@
(
cl-ppcre:register-groups-bind
(
ver
)
(
"^cl-asdf [(]([0-9.:-]+)[)] "
line
)
ver
)))
(
defun
parse-debian-version
(
&optional
(
debian-version
(
debian-version-from-file
)))
(
cl-ppcre:register-groups-bind
(
epoch
ver
rel
)
(
"^(?:([0-9]+):)?([0-9.]+)(?:-([0-9]+))$"
debian-version
)
;; NB: (A) we return version first, not epoch, because it's the primary result!
;; (B) epoch = nil is semantically same as epoch = 0
;; (C) rel = nil is for debian-native packages, e.g. base-passwd or cowbuilder
(
values
ver
epoch
rel
)))
(
defparameter
*version*
(
version-from-file
))
;;; Bumping the version of ASDF
...
...
@@ -44,8 +52,6 @@
(
unparse-version
pv
)))
(
defun
versions-from-args
(
&optional
v1
v2
)
(
when
(
eq
v1
:default
)
(
setf
v1
(
version-from-file
)))
(
when
(
eq
v2
:default
)
(
setf
v2
(
next-version
(
or
v1
(
version-from-file
)))))
(
labels
((
check
(
old
new
)
(
parse-version
old
'error
)
(
parse-version
new
'error
)
...
...
@@ -53,6 +59,7 @@
(
cond
((
and
v1
v2
)
(
check
v1
v2
))
(
v1
(
check
(
version-from-file
)
v1
))
((
not
(
eq
*new-version*
:default
))
*new-version*
)
;; Ugly passing of argument from Makefile.
(
t
(
let
((
old
(
version-from-file
)))
(
check
old
(
next-version
old
)))))))
...
...
@@ -109,20 +116,20 @@
(
defun
test-transform
(
new-version
)
(
apply
'test-transform-file
new-version
(
first
*versioned-files*
)))
(
defun
bump-version
(
&key
(
from
*old-version*
)
(
to
*new-version*
))
(
defun
bump-version
(
&optional
v1
v2
)
"bump version of ASDF to specified version or next development version (do not commit)."
(
with-asdf-dir
()
(
multiple-value-bind
(
old-version
new-version
)
(
versions-from-args
from
to
)
(
versions-from-args
v1
v2
)
(
format
t
"Bumping ASDF version from ~A to ~A~%"
old-version
new-version
)
(
transform-files
new-version
)
(
println
"Rebuilding ASDF with bumped version"
)
(
build-asdf
)
new-version
)))
(
defun
bump
(
&key
(
from
*old-version*
)
(
to
*new-version*
))
(
let
((
v
(
bump-version
:from
from
:to
to
)))
(
defun
bump
(
&optional
v1
v2
)
"bump version of ASDF to specified version or next development version, then commit and tag."
(
let
((
v
(
bump-version
v1
v2
)))
(
git
`
(
commit
-a
-m
(
"Bump version to "
,
v
)))
(
git
`
(
tag
,
v
))
v
))
(
trace
bump-version
versions-from-args
)
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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