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
ba54a1bd
Commit
ba54a1bd
authored
Oct 20, 2013
by
Francois-Rene Rideau
Browse files
More robustification of test-stamp-propagation
parent
44aa97ed
Changes
1
Hide whitespace changes
Inline
Side-by-side
test/stamp-propagation/test-stamp-propagation.lisp
View file @
ba54a1bd
...
...
@@ -32,6 +32,12 @@
(
eval-note
:tsp
)
(
defvar
*tsp*
(
asdf::pathname-directory-pathname
*load-pathname*
))
(
defparameter
*defsystems*
'
(
#+
(
or
allegro
genera
lispworks
)
:native
#+
mk-defsystem
:mk-defsystem
#+
asdf
:asdf
))
(
defvar
*default-defsystem*
(
first
*defsystems*
))
(
defvar
asdf::*asdf-cache*
nil
)
;; if defparameter instead of defvar, disable any surrounding cache
(
defun
lisppath
(
filename
)
(
asdf::subpathname
*tsp*
filename
))
(
defun
faslpath
(
lisppath
&optional
(
defsystem
*default-defsystem*
))
(
funcall
...
...
@@ -42,7 +48,6 @@
(
pathname
lisppath
)
(
string
(
lisppath
lisppath
)))))
(
defvar
asdf::*asdf-cache*
nil
)
;; if defparameter instead of defvar, disable any surrounding cache
(
defun
use-cache-p
(
defsystem
)
(
and
(
eq
defsystem
:asdf
)
...
...
@@ -86,12 +91,6 @@
"file1.lisp"
"file2.lisp"
))
(
defparameter
*defsystems*
'
(
#+
(
or
allegro
genera
lispworks
)
:native
#+
mk-defsystem
:mk-defsystem
#+
asdf
:asdf
))
(
defvar
*default-defsystem*
(
first
*defsystems*
))
(
defun
reload
(
&optional
(
defsystem
*default-defsystem*
))
(
format
t
"~&ASDF-CACHE ~S~%"
asdf::*asdf-cache*
)
(
setf
*eval-notes*
nil
)
...
...
@@ -145,16 +144,24 @@
(
format
t
"~&Testing stamp propagation by defsystem ~S~%"
defsystem
)
#+
allegro
(
progn
(
DBG
"removing any old fasls from another flavor of allegro"
)
(
clear-fasls
defsystem
))
(
when
(
use-cache-p
defsystem
)
(
let
((
tl1
(
file-write-date
(
lisppath
"file1.lisp"
))))
(
touch-file
(
lisppath
"file1.lisp"
)
:timestamp
tl1
:offset
-1000
)
(
touch-file
(
faslpath
"file1.lisp"
)
:timestamp
tl1
:offset
-10000
)
(
touch-file
(
lisppath
"file2.lisp"
)
:timestamp
tl1
:offset
-1000
)
(
touch-file
(
faslpath
"file2.lisp"
)
:timestamp
tl1
:offset
-10000
)))
(
DBG
"loading system"
)
(
reload
defsystem
)
(
cond
((
use-cache-p
defsystem
)
(
DBG
"marking all files old but first source file, and reloading"
)
(
clrhash
(
asdf::component-operation-times
(
asdf:find-component
:test-stamp-propagation
"file1"
)))
(
clrhash
(
asdf::component-operation-times
(
asdf:find-component
:test-stamp-propagation
"file2"
)))
(
let
((
tf2
(
file-write-date
(
faslpath
"file2.lisp"
))))
(
touch-file
(
lisppath
"file1.lisp"
)
:timestamp
tf2
:offset
0
)
(
touch-file
(
faslpath
"file1.lisp"
)
:timestamp
tf2
:offset
-200
0
)
(
touch-file
(
lisppath
"file2.lisp"
)
:timestamp
tf2
:offset
-500
0
)
(
touch-file
(
faslpath
"file2.lisp"
)
:timestamp
tf2
:offset
-100
0
)))
(
touch-file
(
faslpath
"file1.lisp"
)
:timestamp
tf2
:offset
-200
)
(
touch-file
(
lisppath
"file2.lisp"
)
:timestamp
tf2
:offset
-500
)
(
touch-file
(
faslpath
"file2.lisp"
)
:timestamp
tf2
:offset
-100
)))
(
t
(
DBG
"touching first source file and reloading"
)
(
sleep
#-
os-windows
3
#+
os-windows
5
)
...
...
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