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
89b15db3
Commit
89b15db3
authored
Apr 29, 2010
by
Francois-Rene Rideau
Browse files
1.711: make operate a gf, so POIU can hook on it instead of reimplementing it.
parent
ef75676b
Changes
2
Hide whitespace changes
Inline
Side-by-side
asdf.lisp
View file @
89b15db3
...
...
@@ -63,7 +63,7 @@
(
remove
"asdf"
excl::*autoload-package-name-alist*
:test
'equalp
:key
'car
))
(
let*
((
asdf-version
;; the 1+ hair is to ensure that we don't do an inadvertent find and replace
(
subseq
"VERSION:1.71
0
"
(
1+
(
length
"VERSION"
))))
(
subseq
"VERSION:1.71
1
"
(
1+
(
length
"VERSION"
))))
(
existing-asdf
(
find-package
:asdf
))
(
versym
'
#:*asdf-version*
)
(
existing-version
(
and
existing-asdf
...
...
@@ -72,7 +72,7 @@
(
redefined-functions
'
(
#:perform
#:explain
#:output-files
#:operation-done-p
#:perform-with-restarts
#:component-relative-pathname
#:system-source-file
)))
#:system-source-file
#:operate
)))
(
unless
(
equal
asdf-version
existing-version
)
(
when
existing-asdf
(
format
*error-output*
...
...
@@ -1776,9 +1776,11 @@ recursive calls to traverse.")
;;;; -------------------------------------------------------------------------
;;;; Invoking Operations
(
defun
operate
(
operation-class
system
&rest
args
&key
((
:verbose
*asdf-verbose*
)
*asdf-verbose*
)
version
force
&allow-other-keys
)
(
defgeneric
operate
(
operation-class
system
&key
&allow-other-keys
))
(
defmethod
operate
(
operation-class
system
&rest
args
&key
((
:verbose
*asdf-verbose*
)
*asdf-verbose*
)
version
force
&allow-other-keys
)
(
declare
(
ignore
force
))
(
let*
((
*package*
*package*
)
(
*readtable*
*readtable*
)
...
...
@@ -1794,8 +1796,9 @@ recursive calls to traverse.")
(
loop
:for
(
op
.
component
)
:in
steps
:do
(
loop
(
restart-case
(
progn
(
perform-with-restarts
op
component
)
(
return
))
(
progn
(
perform-with-restarts
op
component
)
(
return
))
(
retry
()
:report
(
lambda
(
s
)
...
...
test/test1.script
View file @
89b15db3
...
...
@@ -4,7 +4,6 @@
(quit-on-error
(setf asdf:*central-registry* '(*default-pathname-defaults*))
;;(trace ASDF::MERGE-COMPONENT-RELATIVE-PATHNAME ASDF::COMPONENT-RELATIVE-PATHNAME)
(asdf:operate 'asdf:load-op 'test1)
;; test that it compiled
(let* ((file1 (asdf:compile-file-pathname* "file1"))
...
...
@@ -18,9 +17,7 @@
;; and loaded
(assert (symbol-value (find-symbol (symbol-name :*file1*) :test-package)))
;; now remove one output file and check that the other is _not_
;; recompiled
(sleep 1) ; mtime has 1-second granularity, so pause here for fast machines
;; now remove one output file and check that the other is _not_ recompiled
;;(trace asdf::operation-done-p asdf::traverse)
(asdf::run-shell-command "rm -f ~A" (namestring file2))
...
...
@@ -34,6 +31,7 @@
;; unix cwd. this is not a problem for run-tests.sh, but can be in general
(let ((before (file-write-date file2)))
;; filesystem mtime has 1 second granularity. Make sure even fast machines see a difference.
(sleep 1)
(asdf::run-shell-command "touch file1.lisp")
(asdf:operate 'asdf:load-op 'test1)
...
...
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