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
asdf
asdf
Commits
44aa97ed
Commit
44aa97ed
authored
Oct 20, 2013
by
Francois-Rene Rideau
Browse files
Make test-stamp-propagation succeed (at failing!) on ASDF 2.26,
and more reliably work with ASDF3.
parent
848c2059
Changes
2
Hide whitespace changes
Inline
Side-by-side
test/script-support.lisp
View file @
44aa97ed
...
...
@@ -88,6 +88,7 @@ Some constraints:
(
when
errorp
(
error
"Can't find package ~A"
pname
)))))
(
defun
acall
(
name
&rest
args
)
(
apply
(
apply
'asym
(
if
(
consp
name
)
name
(
list
name
)))
args
))
(
defun
ucall
(
name
&rest
args
)
(
apply
(
asym
name
:uiop
)
args
))
(
defun
asymval
(
name
&optional
package
)
(
symbol-value
(
asym
name
package
)))
(
defsetf
asymval
(
name
&optional
package
)
(
new-value
)
;; NB: defun setf won't work on GCL2.6
...
...
@@ -147,7 +148,7 @@ Some constraints:
(
cond
((
equal
x
y
)
(
format
t
"~S and ~S both evaluate to same path:~% ~S~%"
qx
qy
x
))
((
a
call
:pathname-equal
x
y
)
((
u
call
:pathname-equal
x
y
)
(
warn
"These two expressions yield pathname-equal yet not equal path~%~
the first expression ~S yields this:~% ~S~% ~S~%
the other expression ~S yields that:~% ~S~% ~S~%"
...
...
@@ -257,10 +258,10 @@ Some constraints:
(
decode-universal-time
stamp
#+
gcl2.6
-5
)
;; -5 is for *my* localtime
(
unless
in-filesystem
(
error
"Y U NO use stamp cache?"
))
(
a
call
:run-program
(
u
call
:run-program
`
(
"touch"
"-t"
,
(
format
nil
"~4,'0D~2,'0D~2,'0D~2,'0D~2,'0D.~2,'0D"
year
month
day
hr
min
sec
)
,
(
a
call
:native-namestring
file
)))
,
(
u
call
:native-namestring
file
)))
(
assert-equal
(
file-write-date
file
)
stamp
)))))
(
defun
mark-file-deleted
(
file
)
(
unless
(
asymval
:*asdf-cache*
)
(
error
"Y U NO use asdf cache?"
))
...
...
@@ -325,7 +326,7 @@ is bound, write a message and exit on an error. If
(
break
))
(
t
(
ignore-errors
(
a
call
:print-condition-backtrace
(
u
call
:print-condition-backtrace
c
:count
69
:stream
*error-output*
))
(
leave-test
"Script failed"
1
))))))
(
funcall
(
or
(
asym
:call-with-asdf-cache
)
'funcall
)
thunk
)
...
...
test/stamp-propagation/test-stamp-propagation.lisp
View file @
44aa97ed
...
...
@@ -9,7 +9,8 @@
(
unless
(
find-package
:asdf
)
(
asdf-test::load-asdf
)
(
asdf-test::frob-packages
))
(
asdf-test::frob-packages
)
(
use-package
:uiop
:asdf
))
(
in-package
:asdf-test
)
...
...
@@ -125,7 +126,7 @@
(
defun
touch
(
filename
)
#+
genera
filename
;; TODO: do something with it!
#-
genera
(
uiop:run-program
`
(
"touch"
,
(
native-namestring
filename
))
(
uiop:run-program
`
(
"touch"
,
(
uiop:
native-namestring
filename
))
:output
t
:error-output
t
))
(
defun
clear-fasls
(
&optional
(
defsystem
*default-defsystem*
))
...
...
@@ -166,10 +167,10 @@
((
use-cache-p
defsystem
)
(
DBG
"marking the old fasl new, the second one up to date"
)
(
let
((
tf2
(
file-write-date
(
faslpath
"file2.lisp"
))))
(
touch-file
(
lisppath
"file1.lisp"
)
:timestamp
tf2
:offset
0
)
(
touch-file
(
lisppath
"file1.lisp"
)
:timestamp
tf2
:offset
10
0
)
(
touch-file
(
faslpath
"file1.lisp"
)
:timestamp
tf2
:offset
500
)
(
touch-file
(
lisppath
"file2.lisp"
)
:timestamp
tf2
:offset
0
)
(
touch-file
(
faslpath
"file2.lisp"
)
:timestamp
tf2
:offset
0
)))
(
touch-file
(
lisppath
"file2.lisp"
)
:timestamp
tf2
:offset
10
0
)
(
touch-file
(
faslpath
"file2.lisp"
)
:timestamp
tf2
:offset
10
0
)))
(
t
(
DBG
"touching first fasl file and reloading"
)
(
sleep
#-
os-windows
3
#+
os-windows
5
)
...
...
@@ -182,8 +183,10 @@
(
clear-fasls
defsystem
))
#-
(
or
abcl
xcl
)
;; TODO: figure out why ABCL and XCL fail to recompile anything.
(
test-defsystem
:asdf
)
(
cond
#+
(
and
asdf3
(
not
abcl
)
(
not
xcl
))
;; TODO: figure out why ABCL and XCL fail to recompile anything.
(
t
(
test-defsystem
:asdf
))
(
t
(
signals
error
(
test-defsystem
:asdf
))))
#+
(
or
genera
lispworks
)
(
test-defsystem
:native
)
...
...
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