X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffilesys.lisp;h=cd62fa6a4065ca95d1710cadd7554da0c39ee902;hb=95591ed483dbb8c0846c129953acac1554f28809;hp=f7c95b09204203301b4091d61c5246a7fcf29fd2;hpb=4c4620d79901ec2d2a27e20344af4769eddd4c07;p=sbcl.git

diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp
index f7c95b0..cd62fa6 100644
--- a/src/code/filesys.lisp
+++ b/src/code/filesys.lisp
@@ -471,17 +471,18 @@ or if PATHSPEC is a wild pathname."
 
 (defun delete-file (file)
   #!+sb-doc
-  "Delete the specified FILE."
-  (let* ((truename (probe-file file))
-         (namestring (when truename
-                       (native-namestring truename :as-file t))))
+  "Delete the specified FILE.
+
+If FILE is a stream, on Windows the stream is closed immediately. On Unix
+plaforms the stream remains open, allowing IO to continue: the OS resources
+associated with the deleted file remain available till the stream is closed as
+per standard Unix unlink() behaviour."
+  (let* ((pathname (translate-logical-pathname file))
+         (namestring (native-namestring pathname :as-file t)))
+    (truename file) ; for error-checking side-effect
+    #!+win32
     (when (streamp file)
-      (close file :abort t))
-    (unless namestring
-      (error 'simple-file-error
-             :pathname file
-             :format-control "~S doesn't exist."
-             :format-arguments (list file)))
+      (close file))
     (multiple-value-bind (res err) (sb!unix:unix-unlink namestring)
       (unless res
         (simple-file-perror "couldn't delete ~A" namestring err))))
@@ -790,19 +791,15 @@ Experimental: interface subject to change."
                     ;; end of the line
                     (funcall function subdirectory))
                    ((or (eq :wild next) (typep next 'pattern))
-                    (lambda (pathname)
-                      (map-wild function more pathname)))
+                    (map-wild function more subdirectory))
                    ((eq :wild-inferiors next)
-                    (lambda (pathname)
-                      (map-wild-inferiors function more pathname)))
+                    (map-wild-inferiors function more subdirectory))
                    (t
-                    (lambda (pathname)
-                      (let ((this (pathname-directory pathname)))
-                        (when (equal next (car (last this)))
-                          (map-matching-directories
-                           function
-                           (make-pathname :directory (append this more)
-                                          :defaults pathname)))))))))
+                    (let ((this (pathname-directory subdirectory)))
+                      (map-matching-directories
+                       function
+                       (make-pathname :directory (append this more)
+                                      :defaults subdirectory)))))))
       (map-directory
        (if (eq :wild this)
            #'cont