Skip to content
Snippets Groups Projects
Commit da81dc9e authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

2.100: add compile-file* that outputs to a temporary file and

only overwrites the output-file on success
(also, it calls an updated compile-file-pathname* that heads &key output-file).
Also, merge with 2.002 from release branch.
parent 01107b8c
Branches
Tags
No related merge requests found
...@@ -290,6 +290,7 @@ ...@@ -290,6 +290,7 @@
#:clear-output-translations #:clear-output-translations
#:ensure-output-translations #:ensure-output-translations
#:apply-output-translations #:apply-output-translations
#:compile-file*
#:compile-file-pathname* #:compile-file-pathname*
#:enable-asdf-binary-locations-compatibility #:enable-asdf-binary-locations-compatibility
...@@ -1761,7 +1762,7 @@ recursive calls to traverse.") ...@@ -1761,7 +1762,7 @@ recursive calls to traverse.")
(let ((source-file (component-pathname c)) (let ((source-file (component-pathname c))
(output-file (car (output-files operation c)))) (output-file (car (output-files operation c))))
(multiple-value-bind (output warnings-p failure-p) (multiple-value-bind (output warnings-p failure-p)
(apply #'compile-file source-file :output-file output-file (apply #'compile-file* source-file :output-file output-file
(compile-op-flags operation)) (compile-op-flags operation))
(when warnings-p (when warnings-p
(case (operation-on-warnings operation) (case (operation-on-warnings operation)
...@@ -2928,11 +2929,39 @@ effectively disabling the output translation facility." ...@@ -2928,11 +2929,39 @@ effectively disabling the output translation facility."
(mapcar #'apply-output-translations files))) (mapcar #'apply-output-translations files)))
t)) t))
(defun compile-file-pathname* (input-file &rest keys) (defun compile-file-pathname* (input-file &rest keys &key output-file &allow-other-keys)
(apply-output-translations (or output-file
(apply #'compile-file-pathname (apply-output-translations
(truenamize (lispize-pathname input-file)) (apply 'compile-file-pathname
keys))) (truenamize (lispize-pathname input-file))
keys))))
(defun tmpize-pathname (x)
(make-pathname
:name (format nil "ASDF-TMP-~A" (pathname-name x))
:defaults x))
(defun delete-file-if-exists (x)
(when (probe-file x)
(delete-file x)))
(defun compile-file* (input-file &rest keys)
(let* ((output-file (apply 'compile-file-pathname* input-file keys))
(tmp-file (tmpize-pathname output-file))
(successp nil))
(unwind-protect
(multiple-value-bind (output-truename warnings-p failure-p)
(apply 'compile-file input-file :output-file tmp-file keys)
(if failure-p
(setf output-truename nil)
(setf successp t))
(values output-truename warnings-p failure-p))
(cond
(successp
(delete-file-if-exists output-file)
(rename-file tmp-file output-file))
(t
(delete-file-if-exists tmp-file))))))
#+abcl #+abcl
(defun translate-jar-pathname (source wildcard) (defun translate-jar-pathname (source wildcard)
......
...@@ -71,6 +71,8 @@ ...@@ -71,6 +71,8 @@
<li>pull the latest from our git repository <li>pull the latest from our git repository
(<a href="http://common-lisp.net/gitweb?p=projects/asdf/asdf.git">browse</a>) (<a href="http://common-lisp.net/gitweb?p=projects/asdf/asdf.git">browse</a>)
<pre>git clone git://common-lisp.net/projects/asdf/asdf.git</pre> <pre>git clone git://common-lisp.net/projects/asdf/asdf.git</pre>
(Note that our "master" branch is for current development;
get our "release" branch for the latest stable release.)
</li></ul> </li></ul>
<a id="bugs"> <a id="bugs">
...@@ -100,7 +102,7 @@ ...@@ -100,7 +102,7 @@
<dd>Fran&ccedil;ois-Ren&eacute; Rideau is de facto maintainer, <dd>Fran&ccedil;ois-Ren&eacute; Rideau is de facto maintainer,
with notable contributions from Robert P. Goldman, with notable contributions from Robert P. Goldman,
Juanjo Garcia-Ripoll and James Anderson. Juanjo Garcia-Ripoll and James Anderson.
Push towards an ASDF 2 release ASDF 2 released
with many clean-ups, better configurability with many clean-ups, better configurability
and updated documentation. and updated documentation.
</dd> </dd>
......
(in-package #:common-lisp-user) (in-package #:common-lisp-user)
#+clisp (eval-when (:compile-toplevel) (fmakunbound 'try-recompiling-1))
(defun try-recompiling-1 () (defun try-recompiling-1 ()
(assert *caught-error*)) (assert *caught-error*))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment