X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fasdf%2Fasdf.lisp;h=e2d7bb28c22bc806f14737e001fe4a68c95a71be;hb=6cb4f9ea3f4e35a5a8e75922833e14575ae92180;hp=da1b9bfb8d604498f716bb6b602c3012d51c41d1;hpb=6ffb3a77cf559c6b63f4434e0d3a25b2d8fc04d9;p=sbcl.git

diff --git a/contrib/asdf/asdf.lisp b/contrib/asdf/asdf.lisp
index da1b9bf..e2d7bb2 100644
--- a/contrib/asdf/asdf.lisp
+++ b/contrib/asdf/asdf.lisp
@@ -1,4 +1,4 @@
-;;; This is asdf: Another System Definition Facility.  1.93
+;;; This is asdf: Another System Definition Facility.  1.96
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome: please mail to
 ;;; <cclan-list@lists.sf.net>.  But note first that the canonical
@@ -109,7 +109,7 @@
 
 (in-package #:asdf)
 
-(defvar *asdf-revision* (let* ((v "1.93")
+(defvar *asdf-revision* (let* ((v "1.96")
                                (colon (or (position #\: v) -1))
                                (dot (position #\. v)))
                           (and v colon dot
@@ -442,7 +442,10 @@ system."))
 (defmethod component-relative-pathname ((component source-file))
   (let ((relative-pathname (slot-value component 'relative-pathname)))
     (if relative-pathname
-        relative-pathname
+        (merge-pathnames
+         relative-pathname
+         (make-pathname
+          :type (source-file-type component (component-system component))))
         (let* ((*default-pathname-defaults*
                 (component-parent-pathname component))
                (name-type
@@ -580,26 +583,40 @@ system."))
 (defmethod input-files ((operation operation) (c module)) nil)
 
 (defmethod operation-done-p ((o operation) (c component))
-  (let ((out-files (output-files o c))
-        (in-files (input-files o c)))
-    (cond ((and (not in-files) (not out-files))
-           ;; arbitrary decision: an operation that uses nothing to
-           ;; produce nothing probably isn't doing much
-           t)
-          ((not out-files)
-           (let ((op-done
-                  (gethash (type-of o)
-                           (component-operation-times c))))
-             (and op-done
-                  (>= op-done
-                      (or (apply #'max
-                                 (mapcar #'file-write-date in-files)) 0)))))
-          ((not in-files) nil)
-          (t
-           (and
-            (every #'probe-file out-files)
-            (> (apply #'min (mapcar #'file-write-date out-files))
-               (apply #'max (mapcar #'file-write-date in-files)) ))))))
+  (flet ((fwd-or-return-t (file)
+           ;; if FILE-WRITE-DATE returns NIL, it's possible that the
+           ;; user or some other agent has deleted an input file.  If
+           ;; that's the case, well, that's not good, but as long as
+           ;; the operation is otherwise considered to be done we
+           ;; could continue and survive.
+           (let ((date (file-write-date file)))
+             (cond
+               (date)
+               (t
+                (warn "~@<Missing FILE-WRITE-DATE for ~S: treating ~
+                       operation ~S on component ~S as done.~@:>"
+                      file o c)
+                (return-from operation-done-p t))))))
+    (let ((out-files (output-files o c))
+          (in-files (input-files o c)))
+      (cond ((and (not in-files) (not out-files))
+             ;; arbitrary decision: an operation that uses nothing to
+             ;; produce nothing probably isn't doing much
+             t)
+            ((not out-files)
+             (let ((op-done
+                    (gethash (type-of o)
+                             (component-operation-times c))))
+               (and op-done
+                    (>= op-done
+                        (apply #'max
+                               (mapcar #'fwd-or-return-t in-files))))))
+            ((not in-files) nil)
+            (t
+             (and
+              (every #'probe-file out-files)
+              (> (apply #'min (mapcar #'file-write-date out-files))
+                 (apply #'max (mapcar #'fwd-or-return-t in-files)))))))))
 
 ;;; So you look at this code and think "why isn't it a bunch of
 ;;; methods".  And the answer is, because standard method combination
@@ -1059,14 +1076,15 @@ Returns the new tree (which probably shares structure with the old one)"
 (defun run-shell-command (control-string &rest args)
   "Interpolate ARGS into CONTROL-STRING as if by FORMAT, and
 synchronously execute the result using a Bourne-compatible shell, with
-output to *verbose-out*.  Returns the shell's exit code."
+output to *VERBOSE-OUT*.  Returns the shell's exit code."
   (let ((command (apply #'format nil control-string args)))
     (format *verbose-out* "; $ ~A~%" command)
     #+sbcl
-    (sb-impl::process-exit-code
+    (sb-ext:process-exit-code
      (sb-ext:run-program
-      "/bin/sh"
+      #+win32 "sh" #-win32 "/bin/sh"
       (list  "-c" command)
+      #+win32 #+win32 :search t
       :input nil :output *verbose-out*))
 
     #+(or cmu scl)