Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
asdf
asdf
Commits
1722af58
Commit
1722af58
authored
Jan 30, 2013
by
Francois-Rene Rideau
Browse files
More test system tweaks.
parent
08635fc3
Changes
2
Hide whitespace changes
Inline
Side-by-side
test/run-tests.sh
View file @
1722af58
...
...
@@ -286,7 +286,8 @@ valid_upgrade_test_p () {
# my old ubuntu clisp 2.44.1 is wired in with an antique ASDF 1.374 from CLC that can't be downgraded.
# 2.00[0-7] use UID, which fails on that CLISP and was removed afterwards.
# Note that for the longest time, CLISP has included 2.011 in its distribution.
clisp:2.00[0-7]:
*
)
:
;;
# Since we punt on the upgrade, let's only do the test once, for 2.26.
clisp:2.00[0-7]:
*
|
clisp:1.
*
|
clisp:2.0[01]
*
|
clisp:2.2[0-5]:
*
)
:
;;
# Skip, CMUCL has problems before 2.014.7 due to source-registry upgrade
# Weird unidentified problems before 2.018, so we punt equally for everything before,
# and only need to test it once: above, for 2.017.
...
...
@@ -319,7 +320,7 @@ run_upgrade_tests () {
echo
"or more interactively (and maybe with rlwrap or in emacs), start with:"
echo
"
$cmd
"
echo
"then copy/paste:"
echo
"(load
\"
$su
\"
) (da) (test-upgrade
$method
\"
$tag
\"
)"
echo
"(load
\"
$su
\"
) (
asdf-test::
da) (test-upgrade
$method
\"
$tag
\"
)"
exit
1
;
}
fi
;
done
;
done
2>&1 |
tee
build/results/
${
lisp
}
-upgrade
.text
}
...
...
test/script-support.lisp
View file @
1722af58
...
...
@@ -75,7 +75,7 @@ Some constraints:
(
namestring
(
make-pathname
:name
nil
:type
nil
:defaults
path
))))))
;;; Survival utilities
(
defun
asym
(
name
&optional
package
(
errorp
t
)
)
(
defun
asym
(
name
&optional
package
errorp
)
(
let*
((
pname
(
or
package
:asdf
))
(
package
(
find-package
pname
)))
(
if
package
...
...
@@ -290,7 +290,7 @@ is bound, write a message and exit on an error. If
(
acall
:print-condition-backtrace
c
:count
69
:stream
*error-output*
))
(
leave-test
"Script failed"
1
))))))
(
funcall
(
or
(
asym
:call-with-asdf-cache
:asdf
nil
)
'funcall
)
thunk
)
(
funcall
(
or
(
asym
:call-with-asdf-cache
)
'funcall
)
thunk
)
(
leave-test
"Script succeeded"
0
)))))
(
when
*quit-when-done*
(
exit-lisp
result
))))
...
...
@@ -453,24 +453,30 @@ is bound, write a message and exit on an error. If
(
clean-asdf-system
))
(
defun
configure-asdf
()
(
when
(
asym
:getenvp
nil
nil
)
(
format
t
"Configuring ASDF~%"
)
(
when
(
asym
:getenvp
)
(
format
t
"Enabling debugging~%"
)
(
setf
*debug-asdf*
(
or
*debug-asdf*
(
acall
:getenvp
"DEBUG_ASDF_TEST"
))))
(
eval
`
(
trace
,@
(
loop
:for
s
:in
*trace-symbols*
:collect
(
asym
s
))))
(
when
(
asym
:initialize-source-registry
nil
nil
)
(
when
*trace-symbols*
(
format
t
"Tracing~{ ~A~}~%"
*trace-symbols*
)
(
eval
`
(
trace
,@
(
loop
:for
s
:in
*trace-symbols*
:collect
(
asym
s
)))))
(
when
(
asym
:initialize-source-registry
)
(
acall
:initialize-source-registry
`
(
:source-registry
:ignore-inherited-configuration
)))
(
when
(
asym
:initialize-output-translations
nil
nil
)
(
when
(
asym
:initialize-output-translations
)
(
acall
:initialize-output-translations
`
(
:output-translations
((
,
*asdf-directory*
)
,
(
output-location
"asdf"
))
((
,
(
namestring
*asdf-directory*
)
)
,
(
output-location
"asdf"
))
(
t
,
(
output-location
"root"
))
:ignore-inherited-configuration
)))
(
when
(
asym
:*central-registry*
nil
nil
)
(
when
(
asym
:*central-registry*
)
(
set
(
asym
:*central-registry*
)
`
(
,
*test-directory*
)))
(
format
t
"Being a bit verbose~%"
)
(
when
(
asym
:*asdf-verbose*
)
(
setf
(
asymval
:*asdf-verbose*
)
t
))
(
when
(
asym
:*verbose-out*
)
(
setf
(
asymval
:*verbose-out*
)
*standard-output*
))
(
when
(
asym
:system-source-directory
nil
nil
)
(
let
((
x
(
acall
:system-source-directory
:test-module-depend
)))
(
when
(
and
(
asym
:locate-system
)
(
asym
:pathname-directory-pathname
))
(
format
t
"Comparing directories~%"
)
(
let
((
x
(
acall
:pathname-directory-pathname
(
nth-value
2
(
acall
:locate-system
:test-asdf
)))))
(
assert-pathname-equal
*test-directory*
x
)
;; not always EQUAL (!)
(
unless
(
equal
*test-directory*
x
)
(
format
t
"Interestingly, while *test-directory* has components~% ~S~%~
...
...
@@ -531,16 +537,15 @@ is bound, write a message and exit on an error. If
(
t
(
format
t
"Loading old asdf ~A via ~A~%"
tag
old-method
)
(
funcall
old-method
tag
))))
(
configure-asdf
)
(
when
(
asym
:*asdf-verbose*
nil
nil
)
(
setf
(
asymval
:*asdf-verbose*
)
t
))
(
when
(
asym
:*verbose-out*
nil
nil
)
(
setf
(
asymval
:*verbose-out*
)
*standard-output*
))
(
when
(
find-package
:asdf
)
(
configure-asdf
))
(
format
t
"Now loading new asdf via method ~A~%"
new-method
)
(
funcall
new-method
)
(
format
t
"Testing it~%"
)
(
register-directory
*test-directory*
)
(
load-test-system
:test-module-depend
)
(
assert
(
eval
(
intern
(
symbol-name
'
#:*file1*
)
:test-package
))
)
(
assert
(
eval
(
intern
(
symbol-name
'
#:*file3*
)
:test-package
))))
)
(
assert
(
asymval
'
#:*file1*
:test-package
))
(
assert
(
asymval
'
#:*file3*
:test-package
))))
;; These are shorthands for interactive debugging of test scripts:
(
!a
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment