From d7875c296a4988e9f27e2776237884deb1984c62 Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Fri, 15 Nov 2013 22:27:21 +0400 Subject: [PATCH] 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. --- NEWS | 3 +-- src/code/filesys.lisp | 14 +++++++------- src/code/misc-aliens.lisp | 5 +++++ src/code/win32.lisp | 10 +++++----- 4 files changed, 18 insertions(+), 14 deletions(-) diff --git a/NEWS b/NEWS index 20ede92..43e881f 100644 --- 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 --- 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 --- 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 --- 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) -- 1.7.10.4