Skip to content
Snippets Groups Projects
Commit 42f86c0b authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Moving the build & test code from Makefile + shell to Lisp:

fixing bugs, moving asdf-builder into tools and splitting it into
minimal script itself and Lisp source.
parent db16661b
No related branches found
No related tags found
No related merge requests found
Showing with 1408 additions and 1368 deletions
# -*- Makefile -*- This minimal Makefile delegates most work to the meta-asdf script
# Users, all you need to do is:
# -*- Makefile -*- This minimal Makefile delegates most work to the asdf-tools script
#
# End-Users, all you need to do is:
# make
# Other targets are for the maintainer to use.
#
# Vendors, you may want to test your implementation with:
# make test l=sbcl
#
# Other targets are for maintainer use only.
#
# Default action: bootstrap asdf.lisp
# That's the only thing that we really need before we may invoke asdf-builder.
......@@ -33,10 +33,13 @@ defsystem-files:
### exclude source files from fallback rule.
%.lisp:
@:
Makefile:
@:
### Default fall back rule: delegate to asdf-builder.
### Default fall back rule: delegate to asdf-tools.
%: build/asdf.lisp
@echo "Delegating $@ to asdf-builder" ; ./bin/asdf-builder $@
@echo "Delegating $@ to asdf-tools" ; \
./tools/asdf-tools make-target $@ l="$l" L="$L" u="$u" U="$u" v="$v" s="$s" t="$t"
.PHONY: all driver-files defsystem-files
This diff is collapsed.
#!/bin/sh
# run-tests {lisp invocation} {scripts-regex}
# - read lisp forms one at a time from standard input
# - quit with exit status 0 on getting eof
# - quit with exit status >0 if an unhandled error occurs
usage () {
echo "$0 [lisp invocation] [scripts-regex]"
echo " - read lisp forms one at a time from matching scripts"
echo " - quit with exit status 0 on getting eof"
echo " - quit with exit status >0 if an unhandled error occurs"
echo " you need to supply the .script in the second argument"
echo " lisps include abcl, ccl (clozure),"
echo " allegro, allegro8, allegromodern, allegromodern8,"
echo " allegro_s, allegro8_s, allegromodern_s, allegromodern8_s (SMP variants)"
echo " allegro_64, allegro8_64, allegromodern_64, allegromodern8_64 (64-bit variants),"
echo " allegro_64_s, allegro8_64_s, allegromodern_64_s, allegromodern8_64_s, (SMP, 64-bit variants)"
echo " clisp, cmucl, ecl, gcl, sbcl, scl and xcl."
echo " To configure the script, you may set environment variables to point to the various lisp runtimes."
echo " Allegro CL is a special case: instead of setting environment variables for the specific runtime"
echo " locations, you may simply specify the Allegro install directories using these variables:"
echo " ALLEGRO64DIR, ALLEGRO64SDIR (64-bit Allegro and SMP Allegro, respectively), ALLEGRODIR, and"
echo " ALLEGROSDIR."
echo "OPTIONS:"
echo " -c -- clean load test."
echo " -d -- debug mode."
echo " -t -- test interactively."
echo " -h -- show this message."
echo " -u -- upgrade tests."
echo " -l -- load systems tests."
echo " -H -- extract all asdf versions to upgrade from."
echo " -u -- upgrade tests, we already told you."
}
unset DEBUG_ASDF_TEST upgrade clean_load load_systems test_interactively extract_all
SHELL=/bin/sh
export SHELL DEBUG_ASDF_TEST GCL_ANSI ASDF_OUTPUT_TRANSLATIONS
if [ -n "$ALLEGRO64DIR" ] ; then
ALLEGRO_64=${ALLEGRO64DIR}/alisp
ALLEGRO8_64=${ALLEGRO64DIR}/alisp8
ALLEGROMODERN_64=${ALLEGRO64DIR}/mlisp
ALLEGROMODERN8_64=${ALLEGRO64DIR}/mlisp8
fi
if [ -n "$ALLEGRO64SDIR" ] ; then
ALLEGRO_64_S=${ALLEGRO64SDIR}/alisp
ALLEGRO8_64_S=${ALLEGRO64SDIR}/alisp8
ALLEGROMODERN_64_S=${ALLEGRO64SDIR}/mlisp
ALLEGROMODERN8_64_S=${ALLEGRO64SDIR}/mlisp8
fi
if [ -n "$ALLEGRODIR" ] ; then
ALLEGRO=${ALLEGRODIR}/alisp
ALLEGRO8=${ALLEGRODIR}/alisp8
ALLEGROMODERN=${ALLEGRODIR}/mlisp
ALLEGROMODERN8=${ALLEGRODIR}/mlisp8
fi
if [ -n "$ALLEGROSDIR" ] ; then
ALLEGRO_S=${ALLEGROSDIR}/alisp
ALLEGRO8_S=${ALLEGROSDIR}/alisp8
ALLEGROMODERN_S=${ALLEGROSDIR}/mlisp
ALLEGROMODERN8_S=${ALLEGROSDIR}/mlisp8
fi
while getopts "cdtHulhu" OPTION
do
case $OPTION in
c)
clean_load=t
;;
d)
DEBUG_ASDF_TEST=t
;;
t)
test_interactively=t
;;
h)
usage
exit 1
;;
u)
upgrade=t
;;
l)
load_systems=t
;;
H)
extract_all=t
;;
esac
done
shift $(($OPTIND - 1))
if [ x"$1" = "xhelp" ]; then
usage
exit 1
fi
lisp=${1:-sbcl} ; shift
ECHO () { printf '%s\n' "$*" ;}
ECHOn () { printf '%s' "$*" ;}
DBG () { ECHO "$*" >& 2 ;}
simple_term_p () {
case "$1" in *[!a-zA-Z0-9-+_,.:=%/]*) return 1 ;; *) return 0 ;; esac
}
kwote0 () { ECHOn "$1" | sed -e "s/\([\\\\\"\$\`]\)/\\\\\\1/g" ;}
kwote1 () { if simple_term_p "$1" ; then ECHOn "$1"
else ECHOn "\"$(kwote0 "$1")\"" ; fi ;}
kwote () { ( set +x
k="" ; for i ; do ECHOn "$k" ; kwote1 "$i" ; k=" " ; done ; echo
) }
DO () { kwote "$@" ; "$@" ; }
do_tests () {
if [ -z "$*" ]; then
scripts="*.script"
else
scripts="$*"
fi
env | grep -i asdf
## We go through great lengths to avoid " in the command line,
## the quoting of which many Windows implementations get wrong.
## While we're at it, we also avoid spaces and backslashes.
( DO $bcmd $eval '(or`,#.(load(string`|script-support.lisp|))#.(asdf-test::compile-asdf-script))' )
if [ $? -ne 0 ] ; then
echo "Compilation FAILED" >&2
echo "you can retry compilation with:" >&2
echo ./test/run-tests.sh $lisp >&2
echo "or more interactively (and maybe with rlwrap or in emacs), start with:" >&2
echo "$icmd" >&2
echo "then copy/paste:" >&2
echo '(load "test/script-support.lisp") (asdf-test::compile-asdf-script)' >&2
else
echo "Compiled OK" >&2
test_count=0
test_pass=0
test_fail=0
failed_list=""
for i in $scripts ;
do
echo "Testing: $i" >&2
test_count=`expr "$test_count" + 1`
rm -f ~/.cache/common-lisp/"`pwd`"/* || true
if DO $bcmd $eval "'(#.(load(string'|script-support.lisp|))#.(asdf-test::load-asdf)#.(asdf-test::frob-packages)#.(asdf-test:run-test-script'|$i|))" ; then
echo "Using $command, $i passed" >&2
test_pass=`expr "$test_pass" + 1`
else
echo "Using $command, $i failed" >&2
test_fail=`expr "$test_fail" + 1`
failed_list="$failed_list $i"
echo "you can retry compilation with:" >&2
echo ./test/run-tests.sh $lisp $i >&2
echo "or more interactively (and maybe with rlwrap or in emacs), start with:" >&2
echo "(cd test ; $icmd )" >&2
echo "then copy/paste:" >&2
echo "'(#.(load \"script-support.lisp\") #.(asdf-test::da) #.(load-asdf) #.(frob-packages) #.(asdf::with-asdf-cache () (load \"$i\")))" >&2
fi
echo >&2
echo >&2
done
echo >&2
echo "-#---------------------------------------" >&2
echo "Using $command" >&2
echo "Ran $test_count tests: " >&2
echo " $test_pass passing and $test_fail failing" >&2
if [ $test_fail -eq 0 ] ; then
echo "all tests apparently successful" >&2
echo success > ../build/results/status
else
echo "failing test(s): $failed_list" >&2
fi
echo "-#---------------------------------------" >&2
echo >&2
fi
}
#
# not used currently but leave here for future reference.
#
case $(uname) in
CYGWIN*) os=windows ;;
Darwin) os=macos ;;
Linux) os=linux ;;
*) os=unknown ;;
esac
# terminate on error
set -e
command= flags= nodebug= eval= bcmd= icmd=
case "$lisp" in
abcl)
command="${ABCL:-abcl}"
flags="--noinit --nosystem --noinform"
eval="--eval"
;;
allegro*)
case "$lisp" in
allegro) command="${ALLEGRO:-alisp}" ;;
allegro8) command="${ALLEGRO8:-alisp8}" ;;
allegromodern) command="${ALLEGROMODERN:-mlisp}" ;;
allegromodern8) command="${ALLEGROMODERN8:-mlisp8}" ;;
allegro_s) command="${ALLEGRO_S:-alisp_s}" ;;
allegro8_s) command="${ALLEGRO8_S:-alisp8_s}" ;;
allegromodern_s) command="${ALLEGROMODERN_S:-mlisp_s}" ;;
allegromodern8_s) command="${ALLEGROMODERN8_S:-mlisp8_s}" ;;
allegro_64) command="${ALLEGRO_64:-alisp_64}" ;;
allegro8_64) command="${ALLEGRO8_64:-alisp8_64}" ;;
allegromodern_64) command="${ALLEGROMODERN_64:-mlisp_64}" ;;
allegromodern8_64) command="${ALLEGROMODERN8_64:-mlisp8_64}" ;;
allegro_64_s) command="${ALLEGRO_64_S:-alisp_64_s}" ;;
allegro8_64_s) command="${ALLEGRO8_64_S:-alisp8_64_s}" ;;
allegromodern_64_s) command="${ALLEGROMODERN_64_S:-mlisp_64_s}" ;;
allegromodern8_64_s) command="${ALLEGROMODERN8_64_S:-mlisp8_64_s}" ;;
esac
# For the sake of the lisp-invocation library, re-export these
ALLEGRO=$command ; export ALLEGRO
flags="-q"
nodebug="-batch"
if [ "$os" = windows ] && [ -z "$ALLEGRO_NOISY" ] ; then bcmd="$command +c $flags" ; fi
eval="-e" ;;
ccl)
command="${CCL:-ccl}"
flags="--no-init --quiet"
nodebug="--batch"
eval="--eval" ;;
clisp)
command="${CLISP:-clisp}"
flags="-norc --silent -ansi -I "
nodebug="-on-error exit"
eval="-x" ;;
cmucl)
# cmucl likes to have its executable called lisp, but so does scl
# Please use a symlink or an exec ... "$@" trampoline script.
command="${CMUCL:-cmucl}"
flags="-noinit"
nodebug="-batch"
eval="-eval" ;;
ecl)
command="${ECL:-ecl}"
flags="-norc -load sys:cmp"
eval="-eval" ;;
ecl_bytecodes)
command="${ECL:-ecl}"
flags="-norc -eval (ext::install-bytecodes-compiler)"
eval="-eval" ;;
gcl)
GCL_ANSI=t
command="${GCL:-gcl}"
flags=""
nodebug="-batch"
eval="-eval" ;;
lispworks)
command="${LISPWORKS:-lispworks}"
# If you have a licensed copy of lispworks,
# you can obtain the "lispworks" binary with, e.g.
# echo '(hcl:save-image "/lispworks" :environment nil)' > /tmp/build.lisp ;
# ./lispworks-6-0-0-x86-linux -siteinit - -init - -build /tmp/build.lisp
flags="-siteinit - -init -"
eval="-eval" ;;
mkcl)
command="${MKCL:-mkcl}"
flags="-norc"
eval="-eval" ;;
sbcl)
command="${SBCL:-sbcl}"
flags="--noinform --no-userinit --no-sysinit"
nodebug="--disable-debugger"
eval="--eval" ;;
scl)
command="${SCL:-scl}"
flags="-noinit"
nodebug="-batch"
eval="-eval" ;;
xcl)
command="${XCL:-xcl}"
flags="--no-userinit --no-siteinit --noinform"
eval="--eval" ;;
*)
echo "Unsupported lisp: $1" >&2
echo "Please add support to run-tests.sh" >&2
exit 42 ;;
esac
if ! type "$command" > /dev/null ; then
echo "lisp implementation not found: $command" >&2
exit 43
fi
ASDFDIR="$(cd $(dirname $0)/.. ; /bin/pwd)"
: ${bcmd:=$command $flags} ${icmd:=$command $flags} # batch and interactive
if [ -z "${DEBUG_ASDF_TEST}" ] ; then
bcmd="$bcmd $nodebug"
fi
create_config () {
cd ${ASDFDIR}
mkdir -p build/results/ build/test-source-registry-conf.d build/test-asdf-output-translations-conf.d
}
upgrade_tags () {
if [ -n "$ASDF_UPGRADE_TEST_TAGS" ] ; then
echo $ASDF_UPGRADE_TEST_TAGS ; return
fi
# REQUIRE is a magic tag meaning whatever your implementation provides, if anything
#
# 1.85 (2004-05-16) is the last release by Daniel Barlow (not 1.37, which is the README revision!)
# 1.97 (2006-05-14) is the last release before Gary King takes over
# 1.369 (2009-10-27) is the last release by Gary King
#
# 2.000 to 2.019 and 2.20 to 2.26 are Faré's "stable" ASDF 2 releases
# 2.000 (2010-05-31) was the first ASDF 2 release
# 2.008 (2010-09-10) was a somewhat stable ASDF 2 release
# 2.011 (2010-11-28) was used by CLISP 2.49, Debian squeeze, Ubuntu 10.04 LTS
# 2.014.6 (2011-04-06) was used by Quicklisp in 2011
# 2.019 (2011-11-27) was stable and used by LispWorks since 2012.
# 2.20 (2012-01-18) was in CCL 1.8, Ubuntu 12.04 LTS
# 2.22 (2012-06-12) was used by debian wheezy
# 2.26 (2012-10-30) was used by Quicklisp in 2013
#
# 2.26.x is where the refactoring that begat ASDF 3 took place.
# 2.26.61 is the last single-file, single-package ASDF.
# 2.27 to 2.33 are Faré's "stable" ASDF 3 pre-releases
# 2.27 (2013-02-01) is the first ASDF 3 pre-release
# 2.32 (2013-03-05) is the first really stable ASDF 3 pre-release
#
# The 3.0 series is a stable release of ASDF 3
# with Robert Goldman taking over maintainership at 3.0.2.
# 3.0.0 was just 2.33.10 promoted, but version-satisfies meant it was suddenly
# not compatible with ASDF2 anymore, so we immediately released 3.0.1
# 3.0.1 (2013-05-16) is the first stable ASDF 3 release
# 3.0.2 (2013-07-02) is the first ASDF 3 in SBCL
# 3.0.3 (2013-10-22) is the last in the ASDF 3.0 series
#
# The 3.1 series provides the 3.1 feature, meaning users can rely on
# all the stabilization work done in 3.0 so far, plus extra developments
# in UIOP, package-inferred-system, and more robustification.
# 3.1.2 (2014-05-06) is the first ASDF 3.1 release
#
# We return the above designated versions in order of decreasing relevance,
# which pretty much means REQUIRE and most recent first.
echo REQUIRE
echo 3.1.2
echo 3.0.3 3.0.2 3.0.1
echo 2.32 2.27
echo 2.26 2.22 2.20 2.019 2.014.6 2.011 2.008 2.000
echo 1.369 1.97 1.85
}
upgrade_methods () {
if [ -n "$ASDF_UPGRADE_TEST_METHODS" ] ; then
echo $ASDF_UPGRADE_TEST_METHODS ; return
fi
cat <<EOF
'load-asdf-lisp'load-asdf-lisp-clean
'load-asdf-lisp'load-asdf-system
'load-asdf-lisp'compile-load-asdf-upgrade
'load-asdf-lisp'load-asdf-fasl
()'load-asdf-fasl
'load-asdf-lisp-and-test-uiop'load-asdf-fasl
EOF
}
extract_tagged_asdf () {
cd ${ASDFDIR}
mkdir -p build/
tag=$1
if [ REQUIRE = "$tag" ] ; then return 0 ; fi
file=build/asdf-${tag}.lisp ;
if [ ! -f $file ] ; then
case $tag in
1.*|2.0*|2.2[0-6]|2.26.61)
git show ${tag}:asdf.lisp > $file ;;
2.2[7-9]*|2.[3-9]*|3.*)
mkdir -p build/old/build
git archive ${tag} | (cd build/old/ ; tar xf -)
make -C build/old
mv build/old/build/asdf.lisp build/asdf-${tag}.lisp
rm -rf build/old ;;
*)
echo "Don't know how to extract asdf.lisp for version $tag"
exit 55
;;
esac
fi
}
extract_all_tagged_asdf () {
for i in `upgrade_tags` ; do
extract_tagged_asdf $i
done
}
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]*) : ;;
# 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.
# 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
# the redefinition of system's superclass component.
cmucl:1.*|cmucl:2.*) : ;;
# 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*) : ;;
# 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*) : ;;
# 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:*) : ;;
*) return 0 ;;
esac
return 1
}
run_upgrade_tests () {
cd ${ASDFDIR}
mkdir -p build/results/
rm -f build/*.*f* uiop/*.*f* test/*.*f* ## Remove stale FASLs from ASDF 1.x, especially when different implementations have same name
ASDF_OUTPUT_TRANSLATIONS="(:output-translations (\"${ASDFDIR}\" (\"${ASDFDIR}/build/fasls/\" :implementation \"asdf/\")) (t (\"${ASDFDIR}/build/fasls/\" :implementation \"root/\")) :ignore-inherited-configuration)"
su=test/script-support.lisp
tags="`upgrade_tags`"
methods="`upgrade_methods`"
{
for tag in $tags ; do
for method in $methods ; do
if valid_upgrade_test_p $lisp $tag $method ; then
echo "Testing ASDF upgrade from ${tag} using method $method"
extract_tagged_asdf $tag
$bcmd $eval \
"'(#.(load(string'|$su|))#.#.\`(in-package,:asdf-test)#.(test-upgrade$method\`|$tag|))" ||
{ echo "upgrade FAILED for $lisp from $tag using method $method" ;
echo "you can retry just that test with:" ;
echo ASDF_UPGRADE_TEST_TAGS=\"$tag\" ASDF_UPGRADE_TEST_METHODS=\"$method\" ./test/run-tests.sh -u $lisp ;
echo "or more interactively (and maybe with rlwrap or in emacs), start with:"
echo "$icmd"
echo "then copy/paste:"
echo "(load \"$su\") (asdf-test::da) (test-upgrade $method \"$tag\")"
exit 1 ;}
fi ; done ; done
echo "Upgrade test succeeded for ${lisp}"
} 2>&1 | tee build/results/${lisp}-upgrade.text
}
run_tests () {
create_config
cd ./test/
echo failure > ../build/results/status
thedate=`date "+%Y-%m-%d"`
rm -f "../build/results/${lisp}-test.text" || :
do_tests "$@" 2>&1 | \
tee "../build/results/${lisp}-test.text" "../build/results/${lisp}-test-${thedate}.save"
read a < ../build/results/status
clean_up
if [ success = "$a" ] ; then ## exit code
return 0
else
echo "To view full results and failures, try the following command:" >&2
echo " less -p ABORTED build/results/${lisp}-test.text" >&2
return 1
fi
}
clean_up () {
rm -rf ../build/test-source-registry-conf.d ../build/test-asdf-output-translations-conf.d
}
test_clean_load () {
case $lisp in
gcl|cmucl) return 0 ;; # These are hopeless
esac
cd ${ASDFDIR}
mkdir -p build/results/
nop=build/results/${lisp}-nop.text
load=build/results/${lisp}-load.text
$bcmd $eval \
"(or'#.(load(string'|test/script-support.lisp|):verbose():print())#.(asdf-test:exit-lisp'0))" \
> $nop 2>&1
$bcmd $eval \
"(or'#.(load(string'|test/script-support.lisp|):verbose():print())#.(asdf-test:verbose())#.(load(string'|build/asdf.lisp|):verbose())#.(asdf/image:quit'0))" \
> $load 2>&1
if diff $nop $load ; then
echo "GOOD: Loading ASDF on $lisp produces no message" >&2 ; return 0
else
echo "BAD: Loading ASDF on $lisp produces messages" >&2 ; return 1
fi
}
test_load_systems () {
cd ${ASDFDIR}
mkdir -p build/results/
echo "Loading all these systems: $*"
$bcmd $eval \
"(or #.(load(string'|test/script-support.lisp|))#.(asdf-test:with-test()(asdf-test:test-load-systems $*)))" \
2>&1 | tee build/results/${lisp}-systems.text
}
test_interactively () {
cd ${ASDFDIR}
mkdir -p build/results/
rlwrap $icmd $eval "(or'#.(load(string'|test/script-support.lisp|))#.(asdf-test:interactive-test'($*)))"
}
if [ -z "$command" ] ; then
echo "Error: cannot find or do not know how to run Lisp named $lisp"
elif [ -n "$test_interactively" ] ; then
test_interactively "$@"
elif [ -n "$clean_load" ] ; then
test_clean_load
elif [ -n "$load_systems" ] ; then
test_load_systems "$@"
elif [ -n "$upgrade" ] ; then
run_upgrade_tests
elif [ -n "$extract_all" ] ; then
extract_all_tagged_asdf
else
run_tests "$@"
fi ; exit # NB: "; exit" makes it robust wrt the script being modified while running.
......@@ -628,7 +628,6 @@ is bound, write a message and exit on an error. If
(defun test-upgrade (old-method new-method tag) ;; called by run-test
(with-test ()
(verbose t nil)
(setf tag (string tag))
(when old-method
(cond
((string-equal tag "REQUIRE")
......@@ -639,7 +638,7 @@ is bound, write a message and exit on an error. If
(leave-test "Your Lisp implementation does not provide ASDF. Skipping test.~%" 0)))
(t
(format t "Loading old asdf ~A via ~A~%" tag old-method)
(funcall old-method tag))))
(acall (list old-method :asdf-test) tag))))
(when (find-package :asdf)
(configure-asdf))
(when (and (null old-method) (eq 'load-asdf-fasl new-method) (not (probe-file (asdf-fasl))))
......@@ -647,7 +646,7 @@ is bound, write a message and exit on an error. If
(leave-test "Your failed to compile ASDF before your run (test-upgrade ()'load-asdf-fasl ...)" 1)
(leave-test "Your Lisp doesn't provide ASDF. Skipping (test-upgrade ()'load-asdf-fasl ...)" 0)))
(format t "Now loading new asdf via method ~A~%" new-method)
(funcall new-method)
(acall (list new-method :asdf-test))
(format t "Testing it~%")
(register-directory *test-directory*)
(load-test-system :test-asdf/all)
......
":" ; exec sbcl --script "$0" "$@" ; exit # -*- Lisp -*-
;;;;; Really runs on any decent Common Lisp implementation
;;;;; Can also be invoked by cl-launch 4: cl-launch -sp asdf-tools -r restart -- "$@"
(in-package :cl-user) ;; That may be default, but let's make double sure and tell SLIME.
;;; Ensure we load and configure this particular ASDF
(eval-when (:compile-toplevel :load-toplevel :execute)
(unless (member :cl-launch *features*) ;; (not necessary if we're invoked via cl-launch)
(load (make-pathname
:name "load-asdf" :type "lisp" :defaults
(or *compile-file-truename* *load-truename* (truename *default-pathname-defaults*))))))
;;; ASDF3 is loaded, now use it!
(eval-when (:compile-toplevel :load-toplevel :execute)
(asdf:load-system :asdf-tools))
;;; Actually run the stuff!
(uiop:restore-image :entry-point 'asdf-tools::entry-point)
(defsystem "asdf-tools"
:description "tools to build, test, maintain and release ASDF itself"
: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"))
: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 "main" :depends-on ("package"))))
(in-package :asdf-tools)
(defun build-asdf ()
"Make sure asdf.lisp is built"
(load-system :asdf)
(values))
;;; Documentation
(defun doc ()
(run '(make) :directory (pn "doc/")))
(defun website ()
(run '(make website) :directory (pn "doc/")))
;;; Line counting
(defun wc ()
(with-asdf-dir ()
(run `(pipe (wc ,@(driver-files)) (sort -n)))
(terpri)
(run `(pipe (wc header.lisp ,@(asdf-defsystem-files)) (sort -n)))
(terpri)
(run `(pipe (wc header.lisp ,@(driver-files) ,@(asdf-defsystem-files)) (tail -n 1)))))
(in-package :asdf-tools)
;;; Using git
;; 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)
(with-asdf-dir ()
(apply 'run (cons "git" cmd) args)))
(defun clean ()
(git '(clean -xfd))
(values))
(defun %push ()
"Push git branches master and release to cl.net and master"
(dolist (x '((status)
(push --tags cl.net release master)
(push --tags github release master)
(fetch)
(status)))
(apply 'git x)))
(defun merge-master-into-release ()
"Merge master into release"
(dolist (x '((checkout master)
(merge release)
(checkout release)
(merge master)
(checkout master)))
(apply 'git x)))
(defparameter *wrongful-tags*
'("1.37" ;; It's not asdf.lisp 1.37, it's asdf.lisp 1.85! 1.37 was the CVS version of the README.
"1.1720" ;; That was a typo for 1.720
"RELEASE" "STABLE" ;; These were misguided attempts for what should have been branches
"README" "emp")) ;; Mistakes
(defun fix-local-git-tags ()
"Delete wrongful tags from local repository"
(dolist (tag *wrongful-tags*)
(git `(tag -d ,tag) :on-error t)))
(defun fix-remote-git-tags (&optional (remote "origin"))
"Delete wrongful tags from remote repository"
(dolist (tag *wrongful-tags*)
(git `(push ,remote (:refs/tags/,tag)) :on-error t)))
(defun git-all-committed-p ()
"Is your checkout clean, with all files committed?"
(null (git '(status -s) :output :lines)))
(defun check-git-all-committed ()
(or (git-all-committed-p)
(die 2 "Your git checkout isn't clean and all committed:~%~A~%"
(git '(status) :output :string))))
":" ; exec cl-launch "$0" "$@"
#| -*- Lisp -*-
Usage: make && cl-launch -l lispworks bin/install-asdf-as-module
":" ; exec cl-launch "$0" "$@" # -*- Lisp -*-
#|
Usage: ./tools/asdf-tools install-asdf-as-module l=lispworks
This script will install the current version of ASDF
as a module pre-compiled for your implementation,
......@@ -22,12 +22,13 @@ It notably doesn't work on:
* Corman Lisp, RMCL, Genera, that are obsolete anyway.
|#
(ignore-errors (funcall 'require "asdf")) ;; Load the implementation-provided ASDF
#-asdf2 (load (merge-pathnames ;; Fall back to loading ASDF manually
(make-pathname :name "asdf" :type "lisp" :version nil
:directory '(:relative :back "build") :defaults *load-pathname*)
*load-pathname*))
(asdf:load-system :asdf) ;; Upgrade to the latest ASDF3 (assumes you have it configured properly)
;;; Ensure we load and configure this particular ASDF
#-cl-launch
(eval-when (:compile-toplevel :load-toplevel :execute)
(unless (member :cl-launch *features*) ;; (not necessary if we're invoked via cl-launch)
(load (make-pathname
:name "load-asdf" :type "lisp" :defaults
(or *compile-file-truename* *load-truename* (truename *default-pathname-defaults*))))))
(in-package :asdf)
......
(in-package :asdf-tools)
#|
Supported test lisp implementations include:
allegro, abcl, ccl, clisp, cmucl, ecl, gcl, lispworks, mkcl, sbcl, scl and xcl.
Non supported are:
cormancl, lispworks-personal-edition, mcl, genera
CCL is Clozure CL; (R)MCL is not supported.
Allegro is supported in the following flavors:
allegro, allegro8, allegromodern, allegromodern8,
allegro_s, allegro8_s, allegromodern_s, allegromodern8_s (SMP variants)
allegro_64, allegro8_64, allegromodern_64, allegromodern8_64 (64-bit variants),
allegro_64_s, allegro8_64_s, allegromodern_64_s, allegromodern8_64_s, (SMP, 64-bit variants)
Allegro CL is a special case: instead of setting environment variables for the specific runtime
locations, you may simply specify the Allegro install directories using these variables:
ALLEGRO64DIR, ALLEGRO64SDIR (64-bit Allegro and SMP Allegro, respectively),
ALLEGRODIR, and ALLEGROSDIR.
To configure the lisp implementations with which to run the tests,
you may export environment variables to override the defaults:
ASDF_TEST_LISPS and ASDF_UPGRADE_TEST_LISPS can each be a string of space-separated names
amongst the above implementation names.
You may also explicitly specify the same variables with the respective l= and u= arguments.
Individual test commands only use the first (preferred) provided implementation;
other test commands (named test-all-FOO) iterate over all implementations.
Similarly, you can configure which scripts to tests with ASDF_TEST_SCRIPTS or t=
and which systems to test loading with ASDF_TEST_SYSTEMS or s=
|#
(loop
:for (smpchar smpname smpfullname) :in `(("" "" "") ("S" ,(string :_s) " (SMP)")) :do
(loop
:for (bits bitsname bitsfullname) :in '(("" "") ("64" "_64" " (64-bit words)"))
:for dirvar = (strcat "ALLEGRO" bits smpchar)
:for dir = (getenv-pathname dirvar :want-absolute t :ensure-directory t) :do
(loop :for (charbits charname) :in '(("" "") ("8" " (8-bit chars)")) :do
(loop :for (casechar casename casefullname) :in '(("a" "" "") ("m" :modern " (modern syntax)"))
:for allegro-variant = (conc-keyword :allegro casename charbits bits)
:for fullname = (strcat "Allegro CL"
casefullname charname bitsname smpname)
:for executable = (strcat casechar "lisp" charbits bits) :do
(register-lisp-implementation
allegro-variant
:fullname fullname
:name (native-namestring (subpathname dir executable))
:feature :allegro ;; do we want a more discriminating feature expression?
:flags '("-qq")
:eval-flag "-e"
:load-flag "-L"
;; :quit-flags ("-kill")
:arguments-end "--"
:image-flag "-I"
:image-executable-p nil
:standalone-executable nil
:argument-control t
:disable-debugger `("-batch" ; see also -#D -#C -#!
,@(when (and (os-windows-p) (not (getenvp "ALLEGRO_NOISY")))
'("+c")))
:quit-format "(excl:exit ~A :quiet t)"
:dump-format "(progn (sys:resize-areas :global-gc t :pack-heap t :sift-old-areas t :tenure t) (excl:dumplisp :name ~A :suppress-allegro-cl-banner t))")))))
(loop
:for (ecl-variant extraname flags) :in
'((:ecl "" ("-load" "sys:cmp"))
(:ecl_bytecodes " (using bytecodes compiler)" ("-eval" "(ext::install-bytecodes-compiler)")))
:for fullname = (strcat "Embeddable Common-Lisp" extraname)
:do (register-lisp-implementation
ecl-variant
:fullname fullname
:name "ecl"
:feature :ecl
:environment-variable "ECL"
:flags `("-norc" ,@flags)
:eval-flag "-eval" ; -e
:load-flag "-load"
:image-flag nil
:image-executable-p t
:arguments-end "--"
:argument-control t ;; must be fixed now, but double-checking needed.
:disable-debugger ()
:quit-format "(si:quit ~A)"
:dump-format nil)) ;; Cannot dump with ECL. Link instead.
(defun acceptable-eval-character-p (character)
"Is this character acceptable in an eval form, even when used under Windows?"
(let ((code (char-code character)))
(and (< 32 code 127) (not (find character "'\\\"")))))
(defun acceptable-eval-symbol-character-p (character)
"Is this character acceptable as part of a symbol in an eval form, even when used under Windows?"
(let ((code (char-code character))) ;; assumes uppercase.
;; No "modern" syntax accepted on the test master, though it can be used on the slave.
(and (< 32 code 91) (not (find character "'\\\":;")))))
(defun need-escape-within-pipe-p (character)
"Does this character need to be escaped when within symbol pipe notation?"
(or (eql character #\|) (eql character #\\)))
(defun print-string-in-pipes (string &optional s)
(with-output (s)
(princ "|" s)
(let ((string (string string)))
(if (some 'need-escape-within-pipe-p string)
(loop :for c :across string :do
(when (need-escape-within-pipe-p c) (princ #\\ s))
(princ c s))
(princ string s)))
(princ "|" s)))
(defun compose-eval-string (forms &optional s)
"Given a some FORMS, compose a string suitable to be passed for evaluation
to a Lisp implementation from the shell command-line with e.g. sbcl --eval or equivalent.
Output S is as specified as per WITH-OUTPUT.
FORMS may be a preformatted string, or a list of forms, where each form is either
a preformatted string, or a LIST that specifies a program."
(etypecase forms
;; at the toplevel, a string mean "this is pre-formatted", you know what to pass to --eval
(string
(output-string forms s))
(list
(with-standard-io-syntax
(let ((*package* (find-package :cl)))
(with-output (s)
(labels
((p (x) (princ x s)) ;; princ
(w (x) (write x :stream s :case :downcase)) ;; write
(c (x) ;; form that evaluates into a character
(p "(code-char`") (p (char-code x)) (p ")"))
(sym (x) ;; print a symbol
;; check that only good characters are used in a symbol;
;; TODO: if not, go through a string (ugh!)
(assert (every 'acceptable-eval-symbol-character-p (package-name (symbol-package x))))
(assert (every 'acceptable-eval-symbol-character-p (symbol-name x)))
(w x))
(s (x) ;; form that evaluates into a string
(if (every 'acceptable-eval-character-p x)
(progn ;; simple string literal
(p "(string`") (print-string-in-pipes x s) (p ")"))
(progn
(p "(format()(string`|~{~a~}|)`(")
(loop
:with end = (length x)
:for start = 0 :then (if position (1+ position) end)
:for morep = (< start end)
:for position = (and morep
(position-if-not 'acceptable-eval-character-p x
:start start))
:while morep
:do (when (or (null position) (< start position))
(print-string-in-pipes (subseq x start position) s))
(when position
(p ",") (c (char x position))))
(p "))"))))
(n (x) ;; is it the easy case where no space is needed in the list?
(loop :for (a . d) :on x :do
(cond
((null d) (return t))
((atom d) (return nil))
((or (typep a '(or null character string cons))
(and (typep (car d) 'list) (n (car d)))))
(t (return nil)))))
(f (x) ;; top-level function to print a form without spaces, ' " \
(etypecase x
(null (p "()"))
(symbol (sym x))
(real (w x))
(character (p "#.") (c x))
(string (progn (p "#.") (s x)))
(cons
(if (n x)
(progn (p "(") (map () #'f x) (p ")"))
(progn (p "#.`") (b x))))))
(b (x) ;; print a form that, when inside a backquote, evaluates to the form we want
(etypecase x
(null (p "()"))
(symbol (sym x))
(real (w x))
(character (p ",") (c x))
(string (progn (p ",") (s x)))
(cons
(p "(")
(loop :for (a . d) :on x :do
(b a)
(cond
((null d)) ;; Done: d is a close paren
((typep a '(or null character string cons))) ;; Done: a ends with )
((atom d)
(p ",@") ;; NB: we rely on ,@ being the same as ., in practice
(typecase d
(character (c d))
(string (s d))
(real (w d))
((or keyword (eql t)) (sym d))
(t (p "`") (b d))))
((typep (car d) '(or list character string))) ;; Done: d starts with , or (
((typep (car d) '(or real keyword boolean)) ;; insert a , before constant
(p ","))
((typep (car d) 'symbol)
(p ",`")) ;; insert a ,` before variable symbol
(t (error "foo"))))
(p ")")))))
(p "(quote(")
(loop :for form :in forms :do
(p "#.")
(etypecase form
(string (p form)) ;; forms directly under the top-level can be preformatted, too
(list (f form))))
(p "))"))))))))
(defun compose-copy-paste-string (forms &optional s)
(etypecase forms
(string (output-string forms s))
(list (format s "~{~A~%~}"
(with-standard-io-syntax
(let ((*package* (find-package :cl)))
(mapcar (lambda (x) (typecase x (string x) (t (write x :stream s :case :downcase))))
forms)))))))
;;; The code below exemplifies how to load and configure ASDF
;;; as part of your own deterministic build.
;;; See "User-configurable parts" for where you'd customize it to suit your build.
;;;
;;; We have to play games with packages because on some implementations,
;;; an ASDF upgrade from ASDF 2 can throw away the previous package.
;;;
;;; Everything is MUCH simpler if you can assume your implementation has a recent-enough ASDF 3:
;;; see the commented out alternative below.
;;;
;;; To use the user-configured ASDF rather than a deterministic self-contained project build,
;;; see instead how cl-launch 4.0.4 loads ASDF.
;;; Actually, if you can assume that your implementation or distribution provides ASDF 3,
;;; you may simply use cl-launch, and achieve a deterministic self-contained project build
;;; by having your shell configuration or some shell wrapper script export a proper values
;;; for the CL_SOURCE_REGISTRY and ASDF_OUTPUT_TRANSLATIONS environment variables.
(in-package :cl-user) ;; That may be default, but let's make double sure and tell SLIME.
;; Do everything in eval-when, so this works
;; whether this file is being loaded directly or compiled first.
(eval-when (:compile-toplevel :load-toplevel :execute)
(labels ((asdf-symbol (name)
(and (find-package :asdf) (find-symbol (string name) :asdf)))
(asdf-call (name &rest args)
(apply (asdf-symbol name) args))
(asdf-version ()
(when (find-package :asdf)
(or (symbol-value (or (asdf-symbol '*asdf-version*)
(asdf-symbol '*asdf-revision*)))
"1.0")))
(subpath (parent &key directory name type version)
;; We need subpath here, because we can't yet assume ASDF 3 and its subpathname
(merge-pathnames (make-pathname :defaults parent
:directory (cons :relative directory)
:name name :type type :version version)
parent))
(here-directory ()
(subpath (or *compile-file-truename* *load-truename*
(truename *default-pathname-defaults*))))
(load-and-configure-asdf ()
;; First, try to require ASDF from the implementation, if not already loaded.
;; Most implementations provide ASDF 3.0, LispWorks still lags with ASDF 2.019,
;; and some unmaintained implementations, or obsolete implementations or versions thereof
;; only provide ASDF 2, ASDF 1, or don't provide ASDF.
;; Note that CLISP is case-sensitive, so we need to specify a lowercase string,
;; and not the keyword :asdf or symbol 'asdf; old CLISP versions that don't provide ASDF
;; may error at compile-time if we call (require "asdf") directly.
(ignore-errors (funcall 'require "asdf"))
;; If ASDF 2 isn't provided, load our ASDF from source.
;; ASDF 1 is not enough, because it won't heed our project's output-translations.
;; (Beside, no one serious provides ASDF 1 anymore.)
(unless (member :asdf2 *features*)
(let ((asdf-lisp (asdf-lisp)))
(if (probe-file asdf-lisp)
(load asdf-lisp)
(error "This Lisp implementation fails to provide ASDF 2 or later"))))
;; Configure ASDF
(configure-asdf)
(let ((provided-version (asdf-version)))
;; Upgrade ASDF to what we configured it to be.
(asdf-call 'load-system :asdf)
;; If the implementation-provided version was too old,
;; we need to re-configure, because old configuration may have been moved away.
(unless (asdf-call 'version-satisfies provided-version "2.27")
(configure-asdf)))
(unless (asdf-call 'version-satisfies (asdf-version) (required-asdf-version))
(error "This program needs ASDF ~A but could only find ASDF ~A"
(required-asdf-version) (asdf-version))))
;; User-configurable parts
(required-asdf-version () "3.1.2") ;; In the end, we want at least ASDF 3.1.2
(asdf-lisp ()
;; Here, define where your Lisp source code hierarchy stores its copy of ASDF.
;; In your project, that might be :directory '("libraries" "asdf" "build")
;; Or NIL, if you don't do use any fancy ASDF feature, and
;; trust your implementation to provide a recent enough copy.
(subpath (here-directory) :directory '(:back "build") :name "asdf" :type "lisp"))
(configure-asdf ()
(let* ((source-directory
;; Here, define the top of your Lisp source code hierarchy.
;; If you can assume an implementation that has ASDF 2 or later
;; (you should: all serious ones do), you might compute it based on
;; (asdf-call 'getenv "MY_PROJECT_ROOT") instead of (here-directory).
;; If you can assume an implementation that has ASDF 3 or later
;; (you probably can: most serious ones do), you might use instead
;; (asdf-call 'getenv-pathname "MY_PROJECT_ROOT"
;; :want-absolute t :ensure-directory t)
(subpath (here-directory) :directory '(:back)))
(source-registry
(or (asdf-call 'getenv "ASDF_DEVEL_SOURCE_REGISTRY")
`(:source-registry
(:tree ,source-directory)
;; In a fully controlled build, you'd :ignore-inherited-configuration instead:
:inherit-configuration)))
(output-directory
;; There again, you might want to use some getenv variant.
;; Also, "fasls" might be redundant for your project.
(subpath source-directory :directory '("build" "fasls")))
(output-translations
`(:output-translations
;; Segregate output by ABI.
;; You could replace "asdf" below by the name of your project,
;; or not need it at all if everything is under your source-directory.
(,source-directory (,output-directory :implementation "asdf"))
;; In a fully controlled build, we shouldn't be using code outside
;; our source-directory, but in case we do, we still want to control the output,
;; and easily detect the fact by looking at this directory
(t (,output-directory :implementation "root"))
;; The above should already cover all paths that we use;
;; we don't want user configuration to interfere with the build.
:ignore-inherited-configuration)))
;; No more user-configurable parts below.
(asdf-call 'initialize-source-registry source-registry)
(asdf-call 'initialize-output-translations output-translations))))
;; Configure the printer
(setf *print-readably* nil ; allegro 5.0 may bork without this
*print-level* nil)
;; Hush the compiler and loader
(setf *load-verbose* nil *load-print* nil
*compile-verbose* nil *compile-print* nil)
;; Load and configure ASDF
(load-and-configure-asdf)))
#|
;;; Here is the much simpler code when you can assume
;;; your implementation provides ASDF 3 (i.e. at least pre-release ASDF 2.27).
;;; No package madness.
(eval-when (:compile-toplevel :load-toplevel :execute)
(require "asdf"))
#-asdf3 (error "Your implementation fails to provide ASDF 3")
(in-package :asdf)
(eval-when (:compile-toplevel :load-toplevel :execute)
;; User-configurable parts
(let* ((required-asdf-version "3.1.2") ;; In the end, we want at least ASDF 3.1.2
(here-directory
(pathname-directory-pathname
(or *compile-file-truename* *load-truename*
(truename *default-pathname-defaults*))))
(source-directory
;; Here, define the top of your source code hierarchy.
;; For your project, it could be something like
;; (or (getenv-pathname "MY_PROJECT_ROOT"
;; :want-absolute t :ensure-directory t)
;; (subpathname here-directory "../../"))
(subpathname here-directory "../"))
(source-registry
;; Here, define your source registry.
;; For your project, it would be based solely on source-directory above,
;; and in a fully controlled build, you'd :ignore-inherited-configuration
(or (getenvp "ASDF_DEVEL_SOURCE_REGISTRY")
`(:source-registry
(:tree ,source-directory)
:inherit-configuration)))
(output-directory
;; There again, you might want to use some getenvp variant.
;; Also, "fasls" might be redundant for your project.
(subpathname source-directory "build/fasls/"))
(output-translations
`(:output-translations
;; Segregate output by ABI.
;; You could replace "asdf" below by the name of your project,
;; or not need it at all if everything is under your source-directory.
(,source-directory (,output-directory :implementation "asdf"))
;; In a fully controlled build, we shouldn't be using code outside
;; our source-directory, but in case we do, we still want to control the output,
;; and easily detect the fact by looking at this directory
(t (,output-directory :implementation "root"))
;; The above should already cover all paths that we use;
;; we don't want user configuration to interfere with the build.
:ignore-inherited-configuration)))
;; No more user-configurable parts below.
;; Configure the printer
(setf *print-readably* nil ; allegro 5.0 may bork without this
*print-level* nil)
;; Hush the compiler and loader
(setf *load-verbose* nil *load-print* nil
*compile-verbose* nil *compile-print* nil)
;; Configure ASDF
(initialize-source-registry source-registry)
(initialize-output-translations output-translations)
;; Upgrade to the latest configured version
(upgrade-asdf)
;; Check that we have a satisfactorily version
(unless (version-satisfies (asdf-version) required-asdf-version)
(error "Please install an ASDF ~A or later" required-asdf-version))))
|#
;;;; Generic code to interface a Lisp script to the shell command-line.
(in-package :asdf-tools)
(defun re (arg)
;;; 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"
(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
(try x))))
;;; Main entry point.
;;; NB: For access control, you could check that only exported symbols are used as entry points.
(defun main (args)
(block nil
(unless args
(format t "No command provided~%")
(return))
(if-let ((fun (find-command (first args))))
(let ((results
(multiple-value-list (apply fun (rest args)))))
(when results
(format t "~&~{~S~%~}" results))
(return (first results))))
(format t "Command ~A not found~%" (first args))
(return)))
(defun entry-point ()
(setf *lisp-interaction* nil)
(uiop:with-fatal-condition-handler ()
(initialize-environment)
(main *command-line-arguments*)))
(defpackage :asdf-tools
(:use :common-lisp :uiop :asdf :fare-utils :inferior-shell :lisp-invocation :cl-ppcre))
;; Just so we can use the name in our test scripts...
(defpackage :asdf-test
(:use :common-lisp))
(in-package :asdf-tools)
;;; ASDF directory
(defvar *asdf-dir*
(ensure-pathname (system-relative-pathname :asdf/defsystem ())
:want-physical t :want-absolute t
:want-existing t :truename t))
(defun pn (&rest x)
(subpathname *asdf-dir* (and x (uiop:resolve-relative-location x))))
(defun nn (&rest x)
(native-namestring (apply 'pn x)))
(defun call-with-asdf-dir (thunk &rest subs)
(with-current-directory ((apply 'pn subs))
(funcall thunk)))
(defmacro with-asdf-dir ((&rest subs) &body body)
`(call-with-asdf-dir (lambda () ,@body) ,@subs))
(in-package :asdf-tools)
;;; Getting a list of source files in a system
(defun enough-namestring! (base pathname)
(let ((e (enough-namestring base pathname)))
(assert (relative-pathname-p e))
e))
(defun enough-namestrings (base pathnames)
(loop :with b = (ensure-pathname base :want-absolute t :want-directory t)
:for p :in pathnames
:collect (enough-namestring! p b)))
(defun system-source-files (system &key monolithic)
(let* ((sys (find-system system))
(components
(required-components system
:other-systems monolithic
:goal-operation 'load-op
:keep-operation 'load-op
:keep-component 'file-component))
(dir (ensure-pathname
(system-source-directory sys)
:want-absolute t :want-directory t))
(pathnames (mapcar 'component-pathname components)))
(enough-namestrings dir pathnames)))
;;; Making release tarballs for asdf, asdf/defsystem, uiop.
(defun tarname (name) (strcat name ".tar.gz"))
(defun make-tarball-under-build (name base files)
(check-type name string)
(ensure-pathname base :want-absolute t :want-existing t :want-directory t)
(dolist (f files)
(check-type f string))
(let* ((base
(ensure-pathname
base
:want-absolute t :want-directory t
:want-existing t :truename t))
(destination
(ensure-pathname
name
:defaults (pn "build/")
:want-relative t :ensure-absolute t
:ensure-subpath t :ensure-directory t))
(tarball
(ensure-pathname
(tarname name)
:defaults (pn "build/")
:want-relative t :ensure-absolute t
:ensure-subpath t :want-file t
:ensure-directories-exist t)))
(assert (< 6 (length (pathname-directory destination))))
(when (probe-file* destination)
(error "Destination ~S already exists, not taking chances - you can delete it yourself."
destination))
(ensure-directories-exist destination)
(run `(cp "-pHux" --parents ,@files ,destination) :directory base :show t)
(run `(tar "zcfC" ,tarball ,(pn "build/") (,name /)) :show t)
(delete-directory-tree destination :validate (lambda (x) (equal x destination)))
(values)))
(defun driver-files ()
(list* "README" "uiop.asd" "asdf-driver.asd" (system-source-files :uiop)))
(defun driver-name ()
(format nil "uiop-~A" *version*))
(defun make-driver-tarball ()
(make-tarball-under-build (driver-name) (pn "uiop/") (driver-files)))
(defun asdf-defsystem-files ()
(list* "asdf.asd" "build/asdf.lisp" "version.lisp-expr" "header.lisp"
(system-source-files :asdf/defsystem)))
(defun asdf-defsystem-name ()
(format nil "asdf-defsystem-~A" *version*))
(defun make-asdf-defsystem-tarball ()
(build-asdf)
(make-tarball-under-build (asdf-defsystem-name) (pn) (asdf-defsystem-files)))
(defun asdf-git-name ()
(strcat "asdf-" *version*))
(defun make-git-tarball ()
(build-asdf)
(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))
(defun asdf-lisp-name ()
(format nil "asdf-~A.lisp" *version*))
(defun make-asdf-lisp ()
(build-asdf)
(concatenate-files (list (pn "build/asdf.lisp"))
(pn "build/" (asdf-lisp-name))))
(defun make-archive ()
(make-driver-tarball)
(make-asdf-defsystem-tarball)
(make-git-tarball)
(make-asdf-lisp)
(values))
;;; Publishing tarballs onto the public repository
(defvar *clnet* "common-lisp.net")
(defvar *clnet-asdf-public* "/project/asdf/public_html/")
(defun public-path (x) (strcat *clnet-asdf-public* x))
(defun publish-archive ()
(let ((tarballs (mapcar 'tarname (list (driver-name) (asdf-defsystem-name) (asdf-git-name)))))
(run `(rsync ,@tarballs ,(asdf-lisp-name) (,*clnet* ":" ,(public-path "archives/")))
:show t :directory (pn "build/")))
(format t "~&To download the tarballs, point your browser at:~%
http://common-lisp.net/project/asdf/archives/
~%")
(values))
(defun link-archive ()
(run (format nil "ln -sf ~S ~S ; ln -sf ~S ~S ; ln -sf ~S ~S ; ln -sf ~S ~S"
(tarname (driver-name))
(public-path "archives/uiop.tar.gz")
(tarname (asdf-defsystem-name))
(public-path "archives/asdf-defsystem.tar.gz")
(tarname (asdf-git-name))
(public-path "archives/asdf.tar.gz")
(asdf-lisp-name)
(public-path "archives/asdf.lisp"))
:show t :host *clnet*)
(values))
(defun make-and-publish-archive ()
(make-archive)
(publish-archive)
(link-archive))
(defun archive () "alias for make-and-publish-archive" (make-and-publish-archive))
(defun install () "alias for make-and-publish-archive" (make-and-publish-archive))
;;; Making a debian package
(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))
(error "Debian version ~A doesn't match asdf version ~A" debian-version version))
(clean)
(format t "building package version ~A~%" (debian-version-from-file))
(run `(git-buildpackage
;; --git-ignore-new ;; for testing purpose
(--git-debian-branch= ,release)
(--git-upstream-tag="%(version)s")
;;--git-upstream-tree=tag ;; if the changelog says 3.1.2, looks at that tag
;;(--git-upstream-branch= ,version) ;; if the changelog says 3.1.2, looks at that tag
--git-tag --git-retag
;; --git-no-pristine-tar
--git-force-create
--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"))
(in-package :asdf-tools)
(defun call-with-all-lisps (thunk &optional (lisps *test-lisps*))
(apply 'all-pass
(loop :for lisp :in lisps
:collect (let ((*test-lisps* (list lisp))) (funcall thunk)))))
(defmacro with-all-lisps ((&rest maybe-lisps) &body body)
`(call-with-all-lisps (lambda () ,@body) ,@maybe-lisps))
(deftestcmd test-all-clean-load ()
"test that all lisp implementations can load asdf cleanly without any output message"
(with-all-lisps () (test-clean-load)))
(deftestcmd test-all-lisp ()
"test that all lisp implementations pass all asdf test scripts"
(with-all-lisps () (test-scripts)))
(deftestcmd test-all-no-upgrade ()
"test that all lisp implementations pass all normal asdf; also test-basic"
(all-pass (test-basic) (test-all-lisp)))
(deftestcmd test-all-upgrade ()
"test that all lisp implementations pass all asdf upgrade tests"
(with-all-lisps (*upgrade-test-lisps*) (test-upgrade)))
(deftestcmd test-all-lisps ()
"test that all lisp implementations pass all asdf tests"
(all-pass (test-all-no-upgrade) (test-all-upgrade)))
(defalias test-all test-all-lisps)
(deftestcmd test-all-lisp-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))))
(deftestcmd test-all-upgrade-no-stop ()
"test that all lisp implementations pass all asdf upgrade tests, but don't stop on error"
(with-all-lisps (*upgrade-test-lisps*)
(ignore-errors (test-upgrade))))
(deftestcmd test-all-no-upgrade-no-stop ()
"test that all lisp implementations pass all normal asdf tests (no upgrade), but don't stop on error."
(all-pass
(test-basic)
(test-all-clean-load)
(test-all-lisp-no-stop)
(check-all-test-results)))
(deftestcmd test-all-no-stop ()
"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-upgrade-no-stop)
(check-all-results)))
(deftestcmd check-all-test-results ()
"were there errors in test scripts?"
(with-asdf-dir ()
(let ((a (run/lines
`(grep "-L" "[5-9][0-9] passing and 0 failing"
,(mapcar (lambda (l) (format nil "build/results/~(~A~)-test.text" l))
*test-lisps*)))))
(or (null a)
(progn
(format! *error-output* "Unexpected test failures on these implementations:~%~{~A~%~}" a)
nil)))))
(deftestcmd check-all-upgrade-results ()
"were there upgrade tests failures?"
(with-asdf-dir ()
(let ((a (run/lines
`(grep "-L" "Upgrade test succeeded for "
,(mapcar (lambda (l) (format nil "build/results/~(~A~)-upgrade.text" l))
*upgrade-test-lisps*)))))
(or (null a)
(progn
(format t "Unexpected upgrade failures on these implementations:~%~{~A~%~}~%" a)
nil)))))
(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)))
(in-package :asdf-tools)
(deftestcmd %load (lisp) ;; load would be a clash, so use %load instead
"make load will start a Lisp and load ASDF from individual source files.
This is great to quickly locate compilation errors and interactively debug ASDF."
(with-asdf-dir ()
(run-test-lisp
(format nil "loading ASDF into an interactive ~(~A~)" lisp)
`((load "test/script-support.lisp")
(asdf-test::interactive-test
',(system-source-files :asdf/defsystem :monolithic t)))
:lisp lisp :debugger t :output :interactive)))
(deftestcmd test-load-systems (lisp systems)
"test that the preferred lisp implementation can load your favorite systems without error"
(with-asdf-dir ()
(let* ((log (newlogfile "systems" lisp)))
(log! log "Loading all these systems on ~(~A~):~{~% ~A~}~%~%" lisp systems)
(run-test-lisp
"loading the systems"
`((load "test/script-support.lisp")
(asdf-test::with-test () (asdf-test::test-load-systems ,@systems)))
:lisp lisp :log log))))
(deftestcmd test-clean-load (lisp log)
"test that the preferred lisp implementation can load asdf cleanly without any output message"
(nest
(block ()
(case lisp ((:gcl :cmucl) (return t)))) ;; These are hopeless
(with-asdf-dir ())
(let ((nop (newlogfile "nop" lisp))
(load (newlogfile "load" lisp)))
(run-test-lisp
(format nil "Starting ~(~A~), loading the script support, and exiting without doing anything" lisp)
`((load "test/script-support.lisp" :verbose nil :print nil)
(asdf-test::exit-lisp 0))
:lisp lisp :output nop :log log)
(run-test-lisp
(format nil "Starting ~(~A~), loading the script support, loading ASDF from source, then exiting" lisp)
`((load "test/script-support.lisp" :verbose nil :print nil)
(load "build/asdf.lisp" :verbose nil :print nil)
"(uiop/image:quit 0)")
:lisp lisp :output load :log log)
(if (nth-value 2 (run `(diff ,nop ,load)
:output :interactive :error-output :output :input nil))
(progn
(log! log "GOOD: Loading ASDF on ~(~A~) produces no message" lisp)
(return t))
(progn
(log! log "BAD: Loading ASDF on ~(~A~) produces messages" lisp)
(return nil))))))
;;; BONUS: install asdf as module for your favorite Lisp implementation.
(deftestcmd install-asdf-as-module (lisp)
(flet ((doit ()
(with-asdf-dir ()
(run-test-lisp
(format nil "Installing ASDF to be provided as a module on ~(~A~)" lisp)
'((load "tools/install-asdf-as-module")(uiop:quit))
:lisp lisp))))
(case lisp
((:allegro :allegromodern :ccl :clisp :cmucl :lispworks :sbcl :scl :xcl)
(doit))
((:abcl :ecl :ecl_bytecodes :mkcl)
(format t "Upgrading the implementation-provided ASDF on ~(~A~) isn't supported (yet).
Happily, that implementation is known to keep ASDF reasonably up to date.~%" lisp))
((:cormancl :gcl :genera :mcl :mocl)
(format t "Installing ASDF so it is provided by ~(~A~) isn't supported.
If you care, go hack the implementation.~%" lisp))
(otherwise
(if (string-prefix-p "allegro" (string-downcase lisp))
(doit)
(error "Unknown implementation ~(~A~)" lisp))))))
(deftestcmd test-basic (lisp systems)
"basic smoke test"
(doc)
(test-clean-load lisp)
(test-load-systems lisp systems))
(in-package :asdf-tools)
;;; Testing
(defparameter *test-lisps* :default
"The list of lisp implementations to use for tests")
(defparameter *upgrade-test-lisps* :default
"The list of lisp implementations to use for upgrade tests")
(defparameter *upgrade-test-tags* :default)
(defparameter *test-systems* nil)
(defparameter *test-scripts* :default)
(defparameter *environment-variable-table* nil)
(defparameter *environment-variable-specs*
'((*test-lisps* ensure-list-of-keywords :default
"ASDF_TEST_LISPS" "l")
(*upgrade-test-lisps* ensure-list-of-keywords :default
"ASDF_UPGRADE_TEST_LISPS" "L")
(*test-systems* ensure-list-of-keywords ()
"ASDF_TEST_SYSTEMS" "s")
(*test-scripts* ensure-list-of-strings :default
"ASDF_TESTS" "t")
(*upgrade-test-tags* ensure-list-of-strings :default
"ASDF_UPGRADE_TEST_TAGS" "u")
(*upgrade-test-methods* ensure-list-of-test-methods :default
"ASDF_UPGRADE_TEST_METHODS" "U")
(*new-version* string :default
"=NEW_ASDF_VERSION" "v")))
(defun ensure-list-of-strings (x)
(remove nil
(etypecase x
(string (uiop:split-string x :separator " "))
(list x))))
(defun ensure-keyword (x)
(etypecase x
((or null keyword) x)
((or string symbol) (intern (string-upcase x) :keyword))))
(defun ensure-list-of-keywords (x)
(mapcar 'ensure-keyword (ensure-list-of-strings x)))
(defun ensure-test-method (x)
(safe-read-from-string (strcat "(" (substitute #\space #\: x) ")") :package :keyword)) ; UGLY!
(defun ensure-list-of-test-methods (x)
(mapcar 'ensure-test-method (ensure-list-of-strings x)))
(defun initialize-environment ()
(let ((h (make-hash-table :test 'equal)))
(setf *environment-variable-table* h)
(loop :for (variable transformer defaults envvar short) :in *environment-variable-specs*
:for x = (list variable transformer)
:do (setf (symbol-value variable)
(if-let (x (getenvp envvar))
(funcall transformer x)
defaults))
(setf (gethash envvar h) x)
(setf (gethash short h) x))))
(defun test-definition (def)
(block ()
(cl-ppcre:register-groups-bind (var val) ("^([^=]+)=(.*)$" def)
(if-let (x (gethash var *environment-variable-table*))
(destructuring-bind (sym transformer &rest r) x
(declare (ignore r))
(unless (emptyp val)
(setf (symbol-value sym) (funcall transformer val)))
(return))
(error "Unknown variable ~A" var)))
(error "Unrecognized argument ~A" def)))
(defun show-environment ()
(loop :for (v) :in *environment-variable-specs* :do
(format t "~A = ~S~%" v (symbol-value v)))
t)
(defun make-target (target &rest env)
(map () 'test-definition env)
(shell-boolean-exit (main (list target))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun decl-or-docstring-p (form)
(or (stringp form)
(and (consp form) (eq 'declare (car form)))))
(defun decl-and-body (decl-and-body)
(let ((p (position-if-not 'decl-or-docstring-p decl-and-body)))
(values (subseq decl-and-body 0 p)
(nthcdr p decl-and-body)))))
(defmacro deftestcmd (name args &rest decl-and-body)
(loop :with argmap =
'((lisp ((lisp *test-lisps*))
(setf lisp (get-lisp lisp)))
(lisps ((lisps *test-lisps*))
(setf lisps (get-lisps lisps)))
(systems ((systems *test-systems*)))
(test-scripts ((test-scripts *test-scripts*))
(setf test-scripts (get-test-scripts test-scripts)))
(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))))
:for arg :in args
:for (found larg init) = (assoc arg argmap)
:append (if found larg (list arg)) :into largs
:append (when found (list init)) :into inits
:finally
(multiple-value-bind (decl body) (decl-and-body decl-and-body)
(return
`(defun ,name (&optional ,@largs)
,@decl
,@inits
,@body)))))
(defun all-pass (&rest tests)
(every 'identity tests))
(defmacro defalias (name real)
`(defun ,name (&rest args) ,(format nil "alias for ~S" real) (apply ',real args)))
(deftestcmd interactive-command (lisp)
(let* ((command (lisp-invocation-arglist :implementation-type lisp :debugger t)))
(cons "rlwrap" command)))
(defparameter *default-test-lisps*
'(:ccl :clisp :sbcl :ecl :ecl_bytecodes :cmucl :abcl :scl :allegro
:lispworks :allegromodern :gcl :xcl :mkcl)
;; NOT SUPPORTED BY OUR AUTOMATED TESTS:
;; :cormancl :genera :lispworks-personal-edition :mcl
;; Also, grep for #+/#- features in the test/ directory
;; to see plenty of disabled tests on some platforms
"Default Lisp implementations for tests")
(defun get-lisps (&optional (lisps *test-lisps*))
(if (eq lisps :default) *default-test-lisps* (ensure-list-of-keywords lisps)))
(defun get-lisp (&optional (lisp *test-lisps*))
(if (and (keywordp lisp) (not (eq lisp :default))) lisp (first (get-lisps lisp))))
(defun date-string (&optional (date (get-universal-time)))
(multiple-value-bind (second minute hour date month year weekday daylight-savings-p timezone)
(decode-universal-time date)
(declare (ignore second minute hour weekday daylight-savings-p timezone))
(format nil "~4,'0D-~2,'0D-~2,'0D" year month date)))
(deftestcmd newlogfile ((kind "log") lisp)
(let ((log (pn (format nil "build/results/~(~A-~A~).text" lisp kind))))
(ensure-directories-exist log)
(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))
;;(format t "Logging results to ~A" log)
log))
(defun log! (log fmt &rest args)
(let ((msg (apply 'format nil fmt args)))
(format t "~&~A~&" msg)
(when log
(with-output-file (s log :if-exists :append :if-does-not-exist :create)
;; re-open every time because we're interleaved with inferior process writing to the log,
;; and on e.g. Windows there might be a locking conflict if we keep it open.
(format s "~&~A~&" msg))))
(values))
;; TODO: When composing a form to evaluate in the test lisp implementation,
;; our shell script went through great lengths to avoid a double-quote #\" in the command line,
;; the quoting of which many Windows implementations get wrong.
;; While we're at it, we also avoid spaces and backslashes.
;; We haven't tested our new Lisp implementation of the test infrastructure on Windows, though.
(defun run-test-lisp (activity forms &key (output t) log lisp debugger)
;; Activity is of the form "compiling ASDF", "running this test", etc.
(format t "~&Now ~A...~%" activity)
(let* ((eval (compose-eval-string forms))
(command (lisp-invocation-arglist :implementation-type (get-lisp lisp)
:eval eval :debugger debugger))
(interactive (if (eq output :interactive) :interactive nil))
(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)
(unless interactive
(if (zerop code)
(log! log "SUCCEEDED at ~A." activity)
(log! log "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))))
(in-package :asdf-tools)
(defparameter *default-test-scripts* '("*.script"))
(defun get-test-scripts (&optional (test-scripts *test-scripts*))
(if (eq test-scripts :default) (setf test-scripts *default-test-scripts*))
(with-asdf-dir ("test/")
(sort
(loop :for pattern :in test-scripts
:append (loop :for file :in (directory* pattern)
:collect (enough-pathname file (pn "test/"))))
'string< :key 'namestring)))
#|
;; Somehow we never wrote the tests that check our configuration file infrastructure...
(defun create-config ()
(dolist (x '("build/results/" "build/test-source-registry-conf.d/"
"build/test-asdf-output-translations-conf.d/"))
(ensure-directories-exist (pn x))))
(defun clean-config ()
(flet ((rm-rf (x)
(delete-directory-tree (pn x) :validate (lambda (x) (subpathp x (pn "build/"))))))
(rm-rf "build/test-source-registry-conf.d/")
(rm-rf "build/test-asdf-output-translations-conf.d/")))
|#
(deftestcmd test-scripts (lisp test-scripts)
"run test scripts with the preferred lisp implementation"
(nest
(with-asdf-dir ("test/"))
(let* ((log (newlogfile "test" lisp))
(scripts (get-test-scripts)))
(log! log "Running the following ~D ASDF test scripts on ~(~A~):~%~{ ~A~%~}"
(length scripts) lisp scripts)
(and
(run-test-lisp
"compiling ASDF"
'((load "script-support.lisp") (asdf-test::compile-asdf-script))
:lisp lisp :log log)
(loop
:with n-tests = (length scripts)
:with test-pass = 0
:with test-fail = 0
:with failed-list = ()
:for i :in scripts
:for ni = (native-namestring i)
:for test-count :from 0
:do
;; TODO: do we want to delete the output file cache?
;; If so, we need to do it in the inferior lisp,
;; because only it knows for sure its output configuration.
;; Or we could do it in a more heavy handed way.
(if (run-test-lisp
(format nil "testing ~A on ~(~A~)" i lisp)
`((load "script-support.lisp")
(asdf-test::load-asdf)
(asdf-test::frob-packages)
(asdf-test::run-test-script ,ni))
:lisp lisp :log log)
(incf test-pass)
(progn
(incf test-fail)
(push i failed-list)))
:finally
(let ((okp (zerop test-fail)))
(format t "~
-#---------------------------------------
Using ~A
Ran ~D tests, ~D passed, ~D failed
~:[All tests apparently successful.~;:~:*~{~% ~A~}~]
-#---------------------------------------~%"
lisp
n-tests test-pass test-fail (reverse failed-list))
(unless okp
(log! log "To view full results and failures, try the following command:
less -p ABORTED ~A" (enough-namestring log (pn))))
(return okp)))))))
(deftestcmd %test (lisp test-scripts)
"run all normal tests (excluding upgrade tests) with the preferred lisp implementation"
(all-pass (test-scripts lisp test-scripts) (doc) (test-clean-load lisp)))
(defalias %t %test)
(in-package :asdf-tools)
;;; Upgrade tests
(defun get-upgrade-lisps (&optional (x *upgrade-test-lisps*))
(if (eq x :default) (get-lisps) x))
(defparameter *default-upgrade-test-tags*
;; We return a list of entries in reverse chronological order,
;; which should also be more or less the order of decreasing relevance.
'("REQUIRE" ;; a magic tag meaning whatever your implementation provides, if anything
;; The 3.1 series provides the asdf3.1 feature, meaning users can rely on
;; all the stabilization work done in 3.0 so far, plus extra developments
;; in UIOP, package-inferred-system, and more robustification.
"3.1.2" ;; (2014-05-06) the first ASDF 3.1 release
;; The 3.0 series is a stable release of ASDF 3
;; with Robert Goldman taking over maintainership at 3.0.2.
;; 3.0.0 was just 2.33.10 promoted, but version-satisfies meant it was suddenly
;; not compatible with ASDF2 anymore, so we immediately released 3.0.1
"3.0.3" ;; (2013-10-22) the last in the ASDF 3.0 series
"3.0.2" ;; (2013-07-02) the first ASDF 3 in SBCL
"3.0.1" ;; (2013-05-16) the first stable ASDF 3 release
;; 2.27 to 2.33 are Faré's "stable" ASDF 3 pre-releases
"2.32" ;; (2013-03-05) the first really stable ASDF 3 pre-release
"2.27" ;; (2013-02-01) the first ASDF 3 pre-release
;; The ASDF 2 series
;; Note that 2.26.x is where the refactoring that begat ASDF 3 took place.
;; 2.26.61 is the last single-file, single-package ASDF.
"2.26" ;; (2012-10-30) the last stable ASDF 2 release, long used by Quicklisp, SBCL, etc.
"2.22" ;; (2012-06-12) used by debian wheezy, etc.
"2.20" ;; (2012-01-18) in CCL 1.8, Ubuntu 12.04 LTS
"2.019" ;; (2011-11-29) still included in LispWorks in 2014.
"2.014.6" ;; (2011-04-06) first included in Quicklisp, and for some time.
"2.011" ;; (2010-12-09) long used by CLISP 2.49, Debian squeeze, Ubuntu 10.04 LTS.
"2.008" ;; (2010-09-10) somewhat stable checkpoint in the ASDF 2 series.
"2.000" ;; (2010-05-31) first stable ASDF 2 release.
;; The original ASDF 1 series
"1.369" ;; (2009-10-27) the last release by Gary King
"1.85" ;; (2004-05-16) the last release by Daniel Barlow (not 1.37, which is the README revision!)
"1.97")) ;; (2006-05-14) the last release before Gary King takes over
(defun get-upgrade-tags (&optional (x *upgrade-test-tags*))
(if (eq x :default) *default-upgrade-test-tags* x))
(defun extract-tagged-asdf (tag)
(with-asdf-dir ()
(ensure-directories-exist (pn "build/"))
(unless (string-equal tag "REQUIRE")
(let ((file (pn (strcat "build/asdf-" tag ".lisp"))))
(unless (probe-file file)
(cond
((version<= tag "2.26.61")
(git `(show (,tag ":asdf.lisp") (> ,file))))
(t
(ensure-directories-exist (pn "build/old/build/"))
(run `(pipe (git archive ,tag) (tar "xfC" - (pn "build/old/"))))
(run `(make) :directory (pn "build/old/"))
(rename-file-overwriting-target (pn "build/old/build/asdf.lisp") file))))))))
(deftestcmd extract-all-tagged-asdf (upgrade-tags)
(map () 'extract-tagged-asdf upgrade-tags))
(defalias extract extract-all-tagged-asdf)
(defparameter *upgrade-test-methods* :default)
(defparameter *all-upgrade-test-methods*
'((:load-asdf-lisp :load-asdf-lisp-clean)
(:load-asdf-lisp :load-asdf-system)
(:load-asdf-lisp :compile-load-asdf-upgrade)
(:load-asdf-lisp :load-asdf-fasl)
(() :load-asdf-fasl)
(:load-asdf-lisp-and-test-uiop :load-asdf-fasl)))
(defun get-upgrade-methods (&optional (x *upgrade-test-methods*))
(if (eq x :default) *all-upgrade-test-methods* x))
(defun valid-upgrade-test-p (lisp tag method)
(declare (ignore method))
(or
(string-equal tag "REQUIRE") ;; we are hopefully always able to upgrade from REQUIRE
(ecase lisp
;; ABCL makes it 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) (version<= "2.24" tag))
;; CCL fasl numbering broke loading of old asdf 2.0
((:ccl) (or (version< tag "2.0") (version<= "2.20" tag)))
;; My old Ubuntu 10.04LTS clisp 2.44.1 came wired in
;; with an antique ASDF 1.374 from CLC that can't be removed.
;; 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.
;; However, the was 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 component.
((:cmucl) (version<= "2.33" tag))
;; Skip many ECL tests, for various ASDF issues
((:ecl) (version<= "2.21" tag))
;; GCL 2.7.0 from late November 2013 is required, with ASDF 3.1.2
((:gcl) (version<= "3.1.2" 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))
;; XCL support starts with ASDF 2.014.2
;; — It also dies during upgrade trying to show the backtrace.
;; We recommend you replace XCL's asdf using the install-asdf-as-module script.
((:xcl) (version<= "2.15" tag))
;; all clear on these implementations
((:allegro :lispworks :sbcl :scl) t))))
(deftestcmd test-upgrade (lisp upgrade-tags upgrade-methods)
"run upgrade tests with the preferred lisp implementation"
(nest
(with-asdf-dir ())
(let ((log (newlogfile "upgrade" lisp)))
;; Remove stale FASLs from ASDF 1.x,
;; especially since different implementations may have the same fasl type
(dolist (pattern '("build/*.*f*" "uiop/*.*f*" "test/*.*f*"))
(map () 'delete-file (directory* pattern))))
(loop :for tag :in upgrade-tags :do
(loop :for method :in upgrade-methods
:when (valid-upgrade-test-p lisp tag method) :do
(extract-tagged-asdf tag)
(run-test-lisp
(format nil "Testing ASDF upgrade on ~(~A~) from ~A to ~A using method ~(~{~A~^:~}~)"
lisp tag *version* method)
`((load "test/script-support.lisp")
(asdf-test::test-upgrade ,@method ,tag))
:lisp lisp :log log))
:finally (log! log "Upgrade test succeeded for ~(~A~)" lisp))))
(defalias u test-upgrade)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment