Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Pascal J. Bourguignon
asdf
Commits
e51b3aca
Commit
e51b3aca
authored
Jan 02, 2013
by
Francois-Rene Rideau
Browse files
2.26.48: make ASDF work somewhat on GCL<2.7. Further simplify traverse-action.
parent
bdc9efaf
Changes
19
Expand all
Hide whitespace changes
Inline
Side-by-side
Makefile
View file @
e51b3aca
...
...
@@ -11,6 +11,7 @@ lisps ?= ccl clisp sbcl ecl ecl_bytecodes cmucl abcl scl allegro lispworks alleg
endif
export
ASDF_OUTPUT_TRANSLATIONS
:=
(
:output-translations
(
t
(
"
${sourceDirectory}
/tmp/fasls"
:implementation
))
:ignore-inherited-configuration
)
export
CL_SOURCE_REGISTRY
:=
(
:source-registry
(
:tree
"
${sourceDirectory}
"
)
:ignore-inherited-configuration
)
## MAJOR FAIL: gclcvs -- COMPILER BUG! Upstream fixed it, but upstream fails to compile.
## NOT SUPPORTED BY OUR TESTS: cormancl genera lispworks-personal-edition mkcl rmcl. Manually tested once in a while.
...
...
@@ -29,6 +30,7 @@ SCL ?= scl
ALLEGRO
?=
alisp
ALLEGROMODERN
?=
mlisp
LISPWORKS
?=
lispworks
GCL
?=
gcl
# website, tag, install
...
...
@@ -98,6 +100,7 @@ test-upgrade:
use_abcl
()
{
li
=
"
${ABCL}
--noinit --nosystem --noinform"
;
ev
=
"--eval"
;
}
;
\
use_xcl
()
{
li
=
"
${XCL}
--noinit --nosystem --noinform"
;
ev
=
"--eval"
;
}
;
\
use_scl
()
{
li
=
"
${SCL}
-noinit"
;
ev
=
"-eval"
;
}
;
\
use_gcl
()
{
li
=
"GCL_ANSI=t
${GCL}
"
;
ev
=
"-eval"
;
}
;
\
use_allegro
()
{
li
=
"
${ALLEGRO}
-q"
;
ev
=
"-e"
;
}
;
\
use_allegromodern
()
{
li
=
"
${ALLEGROMODERN}
-q"
;
ev
=
"-e"
;
}
;
\
use_lispworks
()
{
li
=
"
${LISPWORKS}
-siteinit - -init -"
;
ev
=
"-eval"
;
}
;
\
...
...
asdf.asd
View file @
e51b3aca
...
...
@@ -14,7 +14,7 @@
:licence
"MIT"
:description
"Another System Definition Facility"
:long-description
"ASDF builds Common Lisp software organized into defined systems."
:version
"2.26.4
7
"
;; to be automatically updated by bin/bump-revision
:version
"2.26.4
8
"
;; to be automatically updated by bin/bump-revision
:depends-on
()
:components
((
:file
"asdf"
)))
...
...
asdf.lisp
View file @
e51b3aca
This diff is collapsed.
Click to expand it.
test/asdf-pathname-test.script
View file @
e51b3aca
...
...
@@ -56,6 +56,7 @@
(cons "asdf-src" path)))
(bin-dir (&rest path) (append (or (pathname-directory root) (list :relative))
(cons "asdf-bin" path))))
#-gcl<2.7
(setf (logical-pathname-translations "ASDFTEST")
`((,(format nil "**;*.~a" bin-type)
,(make-pathname :directory (bin-dir :wild-inferiors)
...
...
@@ -316,7 +317,7 @@
(format t "output translations: ~S~%" (asdf::output-translations))
#+gcl (format t "~&~A~&" (progn (defvar *x* -1) (incf *x*)))
#-
xcl
;;---*** pathnames are known to be massively broken on XCL
#-
(or xcl gcl<2.7)
;;---*** pathnames are known to be massively broken on XCL
and GCL 2.6
(flet ((same (s1 s2 p1 p2)
(unless (equal (namestring p1) (namestring p2))
(describe p1) (describe p2)
...
...
@@ -331,7 +332,7 @@
#-gcl
(x (asdf::resolve-location '("/foo" "bar" :**/ "baz" #p"*.*") :directory nil :wilden t) #p"/foo/bar/**/baz/*.*")))
#-
xcl
;;---*** pathnames are known to be massively broken on XCL
#-
(or xcl gcl<2.7)
;;---*** pathnames are known to be massively broken on XCL
and GCL 2.6
(or (test-component-pathnames :delete-host t :support-string-pathnames nil)
(leave-lisp "test failed" 1)))
...
...
test/compile-asdf.lisp
View file @
e51b3aca
(
in-package
#
:common-lisp-user
)
(
cl:
in-package
:common-lisp-user
)
(
load
(
make-pathname
:name
"script-support"
:defaults
*load-pathname*
))
(
defun
load-pathname
()
#-
gcl
*load-pathname*
#+
gcl
;; Debian's GCL 2.7 has bugs with compiling multiple-value stuff, but can run ASDF 2.011
(
symbol-value
(
find-symbol
"*LOAD-PATHNAME*"
(
if
(
or
(
<
system::*gcl-major-version*
2
)
;; GCL 2.6 fails to fully compile ASDF at all
(
and
(
=
system::*gcl-major-version*
2
)
(
<
system::*gcl-minor-version*
7
)))
:system
:cl
))))
(
in-package
#:asdf-test
)
(
load
(
make-pathname
:name
"script-support"
:type
"lisp"
:defaults
(
load-pathname
))
#+
gcl
:print
#+
gcl
t
)
(
declaim
(
optimize
(
speed
2
)
(
safety
3
)
#-
allegro
(
debug
3
)
(
in-package
:asdf-test
)
(
declaim
(
optimize
(
speed
2
)
(
safety
3
)
#-
(
or
allegro
gcl
)
(
debug
3
)
#+
(
or
cmu
scl
)
(
c::brevity
2
)))
(
proclaim
'
(
optimize
(
speed
2
)
(
safety
3
)
#-
allegro
(
debug
3
)
(
proclaim
'
(
optimize
(
speed
2
)
(
safety
3
)
#-
(
or
allegro
gcl
)
(
debug
3
)
#+
(
or
cmu
scl
)
(
c::brevity
2
)))
(
defun
my-compile-file
(
&rest
args
)
(
apply
'compile-file
args
))
#+
ecl
(
trace
my-compile-file
)
(
cond
((
not
(
probe-file
*asdf-lisp*
))
(
leave-lisp
"Testsuite failed: unable to find ASDF source"
3
))
...
...
@@ -20,27 +29,10 @@
(
ignore-errors
(
load
*asdf-fasl*
)))
(
leave-lisp
"Reusing previously-compiled ASDF"
0
))
(
t
#+
clisp
(
load-asdf-lisp
)
(
load-asdf-lisp
)
(
let
((
tmp
(
make-pathname
:name
"asdf-tmp"
:defaults
*asdf-fasl*
)))
(
ensure-directories-exist
*asdf-fasl*
)
(
multiple-value-bind
(
result
warnings-p
errors-p
)
;; style warnings shouldn't abort the compilation [2010/02/03:rpg]
(
handler-bind
(
#+
sbcl
(
sb-c::simple-compiler-note
#'
muffle-warning
)
#+
(
and
ecl
(
not
ecl-bytecmp
))
((
or
c:compiler-note
c::compiler-debug-note
c:compiler-warning
)
;; ECL emits more serious warnings than it should.
#'
muffle-warning
)
#+
mkcl
((
or
compiler:compiler-note
)
#'
muffle-warning
)
#-
(
or
cmu
scl
)
(
style-warning
#'
(
lambda
(
w
)
;; escalate style-warnings to warnings - we don't want them.
(
warn
"Can you please fix ASDF to not emit style-warnings? Got a ~S:~%~A"
(
type-of
w
)
w
)
(
muffle-warning
w
))))
(
my-compile-file
*asdf-lisp*
:output-file
tmp
:print
t
:verbose
t
))
(
compile-asdf
tmp
)
(
declare
(
ignore
result
))
(
cond
(
errors-p
...
...
test/run-tests.sh
View file @
e51b3aca
...
...
@@ -12,7 +12,7 @@ usage () {
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, allegro, allegromodern, ccl (clozure),"
echo
" clisp, cmucl, ecl, gclcvs, sbcl, and
s
cl."
echo
" clisp, cmucl, ecl,
gcl,
gclcvs, sbcl,
scl
and
x
cl."
echo
"OPTIONS:"
echo
" -d -- debug mode"
echo
" -u -h -- show this message."
...
...
@@ -143,9 +143,14 @@ case "$lisp" in
command
=
"
${
ECL
:-
ecl
}
"
flags
=
"-norc -eval (ext::install-bytecodes-compiler)"
eval
=
"-eval"
;;
gcl
)
export
GCL_ANSI
=
t
command
=
"
${
GCL
:-
gcl
}
"
flags
=
"-batch"
eval
=
"-eval"
;;
gclcvs
)
export
GCL_ANSI
=
t
command
=
"
${
GCL
:-
gclcvs
}
"
command
=
"
${
GCL
CVS
:-
gclcvs
}
"
flags
=
"-batch"
eval
=
"-eval"
;;
lispworks
)
...
...
test/script-support.lisp
View file @
e51b3aca
...
...
@@ -3,17 +3,17 @@
(
:export
#:*test-directory*
#:*asdf-directory*
#:load-asdf
#:register-directory
#:asdf-load
#:register-directory
#:asdf-load
#:load-asdf-lisp
#:compile-asdf
#:load-asdf-fasl
#:compile-load-asdf
#:load-asdf-system
#:quit-on-error
#:test-asdf
#:native-namestring
#:exit-lisp
#:leave-lisp
#:quietly
))
(
in-package
#
:asdf-test
)
(
in-package
:asdf-test
)
(
declaim
(
optimize
(
speed
2
)
(
safety
3
)
#-
allegro
(
debug
3
)))
(
proclaim
'
(
optimize
(
speed
2
)
(
safety
3
)
#-
allegro
(
debug
3
)))
(
declaim
(
optimize
(
speed
2
)
(
safety
3
)
#-
(
or
allegro
gcl
)
(
debug
3
)))
(
proclaim
'
(
optimize
(
speed
2
)
(
safety
3
)
#-
(
or
allegro
gcl
)
(
debug
3
)))
;;(format t "Evaluating asdf/test/script-support~%")
...
...
@@ -21,11 +21,13 @@
;; We still want to work despite and host/device funkiness.
(
defparameter
*test-directory*
(
make-pathname
:name
nil
:type
nil
:version
nil
:defaults
(
or
*load-truename*
*compile-file-truename*
)))
:defaults
(
or
#+
gcl
(
truename
system:*load-pathname*
)
*load-truename*
*compile-file-truename*
)))
(
defparameter
*asdf-directory*
(
merge-pathnames
(
make-pathname
:directory
'
(
:relative
:back
)
:defaults
*test-directory*
)
*test-directory*
))
(
truename
(
merge-pathnames
(
make-pathname
:directory
'
(
#-
gcl
:relative
#-
gcl
:back
#+
gcl
:parent
)
:defaults
*test-directory*
)
*test-directory*
)))
(
defparameter
*asdf-lisp*
(
make-pathname
:name
"asdf"
:type
"lisp"
:defaults
*asdf-directory*
))
(
defparameter
*asdf-fasl*
...
...
@@ -49,26 +51,37 @@
#+
scl
:scl
#+
xcl
:xcl
))))
(
merge-pathnames
(
make-pathname
:directory
`
(
:relative
"tmp"
"fasls"
,
impl
)
(
make-pathname
:directory
`
(
#-
gcl
:relative
"tmp"
"fasls"
,
impl
)
:defaults
*asdf-directory*
)
*asdf-lisp*
))))
(
defun
load-old-asdf
(
tag
)
(
let
((
old-asdf
(
merge-pathnames
(
make-pathname
:directory
`
(
:relative
"tmp"
)
(
make-pathname
:directory
`
(
#-
gcl
:relative
"tmp"
)
:name
(
format
nil
"asdf-~A"
tag
)
:defaults
*asdf-directory*
)
*asdf-lisp*
)))
(
handler-bind
(
#+
sbcl
(
sb-kernel:redefinition-warning
#'
muffle-warning
))
(
load
old-asdf
))))
(
defun
configure-asdf
()
(
funcall
(
find-symbol
(
string
:initialize-source-registry
)
:asdf
)
`
(
:source-registry
:ignore-inherited-configuration
))
(
let
((
registry
(
find-symbol
(
string
:*central-registry*
)
:asdf
)))
(
set
registry
`
(
,
*asdf-directory*
,
*test-directory*
))))
(
defun
load-asdf
()
(
load
*asdf-fasl*
)
(
use-package
:asdf
:asdf-test
)
(
import
'DBG
:asdf
)
;;(import 'DBG :asdf)
(
configure-asdf
)
(
setf
*package*
(
find-package
:asdf-test
)))
(
defun
hash-table->alist
(
table
)
(
loop
:for
key
:being
:the
:hash-keys
:of
table
:using
(
:hash-value
value
)
:collect
(
cons
key
value
)))
(
defun
common-lisp-user::load-asdf
()
(
load-asdf
))
...
...
@@ -164,9 +177,31 @@ is bound, write a message and exit on an error. If
(
defun
load-asdf-lisp
()
(
load
*asdf-lisp*
))
(
defun
compile-asdf
()
#+
(
or
gcl
genera
)
(
unless
(
fboundp
'ensure-directories-exist
)
(
defun
ensure-directories-exist
(
path
)
#+
genera
(
fs:create-directories-recursively
(
pathname
path
))
#+
gcl
(
lisp:system
(
format
nil
"mkdir -p ~S"
(
namestring
(
make-pathname
:name
nil
:type
nil
:defaults
path
))))))
(
defun
compile-asdf
(
&optional
(
output
*asdf-fasl*
))
(
ensure-directories-exist
*asdf-fasl*
)
(
compile-file
*asdf-lisp*
:output-file
*asdf-fasl*
:verbose
t
:print
t
))
;; style warnings shouldn't abort the compilation [2010/02/03:rpg]
(
handler-bind
(
#+
sbcl
(
sb-c::simple-compiler-note
#'
muffle-warning
)
#+
(
and
ecl
(
not
ecl-bytecmp
))
((
or
c:compiler-note
c::compiler-debug-note
c:compiler-warning
)
;; ECL emits more serious warnings than it should.
#'
muffle-warning
)
#+
mkcl
((
or
compiler:compiler-note
)
#'
muffle-warning
)
#-
(
or
cmu
scl
)
(
style-warning
#'
(
lambda
(
w
)
;; escalate style-warnings to warnings - we don't want them.
(
warn
"Can you please fix ASDF to not emit style-warnings? Got a ~S:~%~A"
(
type-of
w
)
w
)
(
muffle-warning
w
))))
(
compile-file
*asdf-lisp*
:output-file
output
#-
gcl
:verbose
#-
gcl
t
:print
t
)))
(
defun
load-asdf-fasl
()
(
load
*asdf-fasl*
))
...
...
@@ -220,6 +255,12 @@ outputs a tag plus a list of variable and their values, returns the last value"
(
pushnew
:DBG
*features*
)
#+
gcl
(
eval-when
(
:compile-toplevel
:load-toplevel
:execute
)
(
DBG
:script-support
*package*
*test-directory*
*asdf-directory*
*asdf-lisp*
*asdf-fasl*
))
#|
#+DBG
(DBG :cas o c just-done base-stamp stamp-lookup out-files in-files
file-op null
-op op-time
op-stamp
dep-stamp out-stamps in-stamps missing-in missing-out all-present earliest-out latest-in
done-stamp (stamp<= latest-in earliest-out)
(operation-done-p o c))
(DBG :cas o c just-done base-stamp stamp-lookup out-files in-files
out
-op op-time dep-stamp out-stamps in-stamps missing-in missing-out all-present earliest-out latest-in
up-to-date-p done-stamp
(operation-done-p o c))
|#
test/test-builtin-source-file-type.script
View file @
e51b3aca
...
...
@@ -6,8 +6,7 @@
(quit-on-error
(format t "~D~%" (asdf:asdf-version))
(setf asdf:*central-registry* '(*default-pathname-defaults*))
(asdf:load-system 'test-builtin-source-file-type-1 :verbose t)
(load-system 'test-builtin-source-file-type-1 :verbose t)
(assert (symbol-value (read-from-string "test-package::*test-tmp-cl*")))
(assert-equal
(mapcar #'pathname-type
...
...
@@ -24,5 +23,4 @@
'("lisp" "cl"))
(delete-package :test-package)
(asdf:load-system 'test-builtin-source-file-type-4 :verbose t)
(assert (symbol-value (read-from-string "test-package::*test-tmp-cl*")))
)
(assert (symbol-value (read-from-string "test-package::*test-tmp-cl*"))))
test/test-logical-pathname.script
View file @
e51b3aca
...
...
@@ -2,6 +2,7 @@
(load "script-support.lisp")
(load-asdf)
#-gcl<2.7
(setf (logical-pathname-translations "ASDF")
#+(or allegro clisp)
`(("**;*.*.*" ,(asdf::wilden *asdf-directory*)))
...
...
@@ -16,14 +17,14 @@
(format t "~S~%" (translate-logical-pathname "ASDF:test;test-force.asd"))
(format t "~S~%" (truename "ASDF:test;test-force.asd"))
#-
xcl
#-
(or xcl gcl<2.7)
(progn
(format t "Test logical pathnames in central registry~%")
(setf *central-registry* '(#p"ASDF:test;"))
(initialize-source-registry '(:source-registry :ignore-inherited-configuration))
(load-system :test-logical-pathname :force t))
#-
xcl
#-
(or xcl gcl<2.7)
(progn
(format t "Test logical pathnames in source-registry, non-recursive~%")
(clear-system :test-logical-pathname)
...
...
@@ -32,7 +33,7 @@
'(:source-registry (:directory #p"ASDF:test;") :ignore-inherited-configuration))
(load-system :test-logical-pathname :force t))
#-
xcl
#-
(or xcl gcl<2.7)
(progn
(format t "Test logical pathnames in source-registry, recursive~%")
(clear-system :test-logical-pathname)
...
...
test/test-nested-1.lisp
View file @
e51b3aca
(
in-package
#
:asdf-test
)
(
in-package
:asdf-test
)
test/test-nested-components-1.asd
View file @
e51b3aca
;;; -*- Mode: common-lisp; Syntax: Common-Lisp; -*-
(
in-package
#
:common-lisp-user
)
(
in-package
:common-lisp-user
)
(
defpackage
#:test-nested-components.system
(
:use
#:common-lisp
#:asdf
))
(
in-package
#
:test-nested-components.system
)
(
in-package
:test-nested-components.system
)
(
defsystem
test-nested-components-a
:components
...
...
test/test-retry-loading-component-1.script
View file @
e51b3aca
...
...
@@ -4,35 +4,27 @@
(load "script-support.lisp")
(load-asdf)
;(trace asdf::find-component)
;(trace asdf:run-shell-command asdf:oos asdf:perform asdf:operate)
;#+allegro
;(trace excl.osi:command-output)
(defvar *caught-error* nil)
(quit-on-error
;;(format t "trlc1 1~%")
(when (probe-file "try-reloading-dependency.asd")
(asdf:run-shell-command "rm -f ~A"
(namestring "try-reloading-dependency.asd")))
(setf asdf:*central-registry* '(*default-pathname-defaults*))
(DBG "trlc1 1")
(asdf::delete-file-if-exists "try-reloading-dependency.asd")
(setf asdf::*defined-systems* (asdf::make-defined-systems-table))
;;(format t
"trlc1 2
~%
")
(DBG
"trlc1 2")
(handler-bind ((error (lambda (c)
(format t "~&Caught error ~s" c)
(setf *caught-error* t)
(asdf:run-shell-command
"cp try-reloading-dependency.hidden try-reloading-dependency.asd")
;;(format t
"trlc1 5
~%
")
(DBG
"trlc1 5")
(multiple-value-bind (name mode)
(find-symbol (symbol-name 'retry) :asdf)
(DBG "trlc1 6" name mode)
(assert (eq mode :external) nil "Mode of ~s was not external" name)
;;(format t "trlc1 6~%")
(let ((restart (find-restart name c)))
;;(format t "trlc1 7~%"
)
(DBG "trlc1 7" restart
)
(assert restart)
(format t "~&restart: ~S~&" restart)
(when restart (invoke-restart restart)))))))
;;(format t
"trlc1 3
~%
")
(DBG
"trlc1 3")
(asdf:oos 'asdf:load-op 'try-reloading-1))
;;(format t
"trlc1 4
~%
")
(DBG
"trlc1 4")
(assert *caught-error*))
test/test-tmp.cl
View file @
e51b3aca
;; part of the test-module-pathnames test
(
in-package
#
:test-package
)
(
in-package
:test-package
)
(
defparameter
*test-tmp-cl*
t
)
...
...
test/test-tmp.lsp
View file @
e51b3aca
;; part of the test-module-pathnames test
(in-package
#
:test-package)
(in-package :test-package)
(defparameter *test-tmp-cl* t)
...
...
test/test-utilities.script
View file @
e51b3aca
...
...
@@ -10,9 +10,9 @@
(assert
(every #'directory-pathname-p
(list
(make-pathname :name nil :type "" :directory '(:absolute "tmp"))
(make-pathname :name "" :directory '(:absolute "tmp"))
(make-pathname :type "" :directory '(:absolute "tmp"))
(make-pathname
*
:name nil :type "" :directory '(:absolute "tmp"))
(make-pathname
*
:name "" :directory '(:absolute "tmp"))
(make-pathname
*
:type "" :directory '(:absolute "tmp"))
;; CLHS 19.2.2.2.3 says we can't portably specify :unspecific here,
;; and some implementations will enforce it.
;; (make-pathname :type :unspecific :directory '(:absolute "tmp"))
...
...
@@ -22,11 +22,11 @@
(assert
(every (complement #'directory-pathname-p)
(list
(make-pathname :name "foo" :type nil :directory '(:absolute "tmp"))
(make-pathname :name nil :type "bar" :directory '(:absolute "tmp")))))
(make-pathname
*
:name "foo" :type nil :directory '(:absolute "tmp"))
(make-pathname
*
:name nil :type "bar" :directory '(:absolute "tmp")))))
;; These are funky and non portable. Omit from tests.
;; (make-pathname :name "." :type nil :directory '(:absolute "tmp"))
;; (make-pathname :name "." :type "" :directory '(:absolute "tmp"))
;; (make-pathname
*
:name "." :type nil :directory '(:absolute "tmp"))
;; (make-pathname
*
:name "." :type "" :directory '(:absolute "tmp"))
(assert (equal (multiple-value-list (component-name-to-pathname-components "" :force-directory t))
'(:relative nil nil)))
(assert (equal (multiple-value-list (component-name-to-pathname-components "" :force-directory nil))
...
...
test/test1.preferences
View file @
e51b3aca
(in-package
#
:asdf-test)
(in-package :asdf-test)
(setf *test6* :yes)
test/test8.script
View file @
e51b3aca
...
...
@@ -4,7 +4,7 @@
(load "script-support.lisp")
(load-asdf)
(in-package
#
:asdf-test)
(in-package :asdf-test)
(quit-on-error
(setf asdf:*central-registry* '(*default-pathname-defaults*))
...
...
test/try-recompiling-1.lisp
View file @
e51b3aca
(
in-package
#
:asdf-test
)
(
in-package
:asdf-test
)
#+
clisp
(
eval-when
(
:compile-toplevel
)
(
fmakunbound
'try-recompiling-1
))
...
...
test/wild-module.script
View file @
e51b3aca
...
...
@@ -2,6 +2,5 @@
(load "script-support.lisp")
(load-asdf)
(quit-on-error
(load "../wild-modules.lisp")
(setf *central-registry* '(*default-pathname-defaults*))
(load (asdf:system-relative-pathname :asdf "wild-modules.lisp"))
(load-system :wild-module))
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