Fix system error message decoding on Windows.

It used a scheme where negative error codes indicated the need to use
FormatMessage instead of strerror(3), but the sb-int::strerror
function didn't know about such arrangements and called strerror(3)
with negative codes, resulting in "Unknown error".
Remove negation, and unconditionally call FormatMessage on Windows.

diff --git a/NEWS b/NEWS
index 20ede92..43e881f 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -9,8 +9,7 @@ changes relative to sbcl-1.1.13:
     Thanks to Jan Moringen. (lp#1249055)
   * enhancement: Top-level defmethod without defgeneric no longer causes
     undefined-function warnings in subsequent forms. (lp#503095)
-  * enhancement: Errors during loading foreign libraries on Windows now
-    include error messages instead of error codes.
+  * enhancement: Better error messages for system errors on Windows.
   * enhancement: run-sbcl.sh is usefully handled by rlwrap.  Thanks to William
     Cushing. (lp#1249183)
   * enhancement: new function SB-EXT:ASSERT-VERSION->= accepts a version

diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp
index 49218ae..f013fb1 100644 (file)
--- a/src/code/filesys.lisp
+++ b/src/code/filesys.lisp
@@ -308,12 +308,12 @@
                    (pathname-host pathname)
                    (sane-default-pathname-defaults)
                    :as-directory (eq :directory kind)))
-                 (fail "couldn't resolve ~A" filename
-                       (- (sb!win32:get-last-error))))))
+                 (fail (format nil "Failed to find the ~A of ~~A" query-for) filename
+                       (sb!win32:get-last-error)))))
           (:write-date
            (or (sb!win32::native-file-write-date filename)
-               (fail "couldn't query write date of ~A" filename
-                     (- (sb!win32:get-last-error))))))
+               (fail (format nil "Failed to find the ~A of ~~A" query-for) filename
+                       (sb!win32:get-last-error)))))
         #!-win32
         (multiple-value-bind (existsp errno ino mode nlink uid gid rdev size
                                       atime mtime)
@@ -390,7 +390,7 @@
                              (:write-date (+ unix-to-universal-time mtime))))))
                      ;; If we're still here, the file doesn't exist; error.
                      (fail
-                      (format nil "failed to find the ~A of ~~A" query-for)
+                      (format nil "Failed to find the ~A of ~~A" query-for)
                       pathspec errno)))
             (if existsp
                 (case query-for
@@ -497,7 +497,7 @@ per standard Unix unlink() behaviour."
     (multiple-value-bind (res err)
         #!-win32 (sb!unix:unix-unlink namestring)
         #!+win32 (or (sb!win32::native-delete-file namestring)
-                     (values nil (- (sb!win32:get-last-error))))
+                     (values nil (sb!win32:get-last-error)))
         (unless res
           (simple-file-perror "couldn't delete ~A" namestring err))))
   t)
@@ -556,7 +556,7 @@ exist or if is a file or a symbolic link."
                  (multiple-value-bind (res errno)
                      #!+win32
                      (or (sb!win32::native-delete-directory namestring)
-                         (values nil (- (sb!win32:get-last-error))))
+                         (values nil (sb!win32:get-last-error)))
                      #!-win32
                      (values
                       (not (minusp (alien-funcall

diff --git a/src/code/misc-aliens.lisp b/src/code/misc-aliens.lisp
index bf11807..f3a55c3 100644 (file)
--- a/src/code/misc-aliens.lisp
+++ b/src/code/misc-aliens.lisp
@@ -22,5 +22,10 @@
       "Return the value of the C library pseudo-variable named \"errno\".")
 
 ;;; Decode errno into a string.
+#!-win32
 (defun strerror (&optional (errno (get-errno)))
   (alien-funcall (extern-alien "strerror" (function c-string int)) errno))
+
+#!+win32
+(defun strerror (&optional (errno (sb!win32:get-last-error)))
+  (sb!win32:format-system-message errno))

diff --git a/src/code/win32.lisp b/src/code/win32.lisp
index d1b7b5c..41b8068 100644 (file)
--- a/src/code/win32.lisp
+++ b/src/code/win32.lisp
@@ -555,13 +555,13 @@
            (type sb!unix:unix-file-mode mode)
            (ignore mode))
   (syscall (("CreateDirectory" t) lispbool system-string (* t))
-           (values result (if result 0 (- (get-last-error))))
+           (values result (if result 0 (get-last-error)))
            name nil))
 
 (defun sb!unix:unix-rename (name1 name2)
   (declare (type sb!unix:unix-pathname name1 name2))
   (syscall (("MoveFile" t) lispbool system-string system-string)
-           (values result (if result 0 (- (get-last-error))))
+           (values result (if result 0 (get-last-error)))
            name1 name2))
 
 (defun sb!unix::posix-getenv (name)
@@ -880,7 +880,7 @@ absense."
       (set-file-pointer-ex handle offset whence)
     (if moved
         (values to-place 0)
-        (values -1 (- (get-last-error))))))
+        (values -1 (get-last-error)))))
 
 ;; File mapping support routines
 (define-alien-routine (#!+sb-unicode "CreateFileMappingW"
@@ -1016,7 +1016,7 @@ absense."
                        sb!unix:enoent)
                       ((#.error_already_exists #.error_file_exists)
                        sb!unix:eexist)
-                      (otherwise (- error-code)))))
+                      (otherwise error-code))))
           (progn
             ;; FIXME: seeking to the end is not enough for real APPEND
             ;; semantics, but it's better than nothing.
@@ -1160,7 +1160,7 @@ absense."
         (duplicate-handle me fd me 0 t +duplicate-same-access+)
       (if duplicated
           (values handle 0)
-          (values nil (- (get-last-error)))))))
+          (values nil (get-last-error))))))
 
 (defun call-with-crt-fd (thunk handle &optional (flags 0))
   (multiple-value-bind (duplicate errno)