Add syscall info to posix errors.

diff --git a/posix/basic-unix.lisp b/posix/basic-unix.lisp
index fcc16e7..756fec9 100644 (file)
--- a/posix/basic-unix.lisp
+++ b/posix/basic-unix.lisp
@@ -48,12 +48,14 @@
       (strerror-r errno buf bufsiz))))
 
 (defmethod print-object ((posix-error posix-error) stream)
-  (print-unreadable-object (posix-error stream :type t :identity nil)
-    (let ((code (system-error-code posix-error))
-          (identifier (system-error-identifier posix-error)))
-      (format stream "~s ~s ~s"
-              (or code "[No code]") identifier
-              (or (strerror code) "[Can't get error string.]")))))
+ (print-unreadable-object (posix-error stream :type t :identity nil)
+   (let ((code (system-error-code posix-error))
+         (identifier (system-error-identifier posix-error))
+         (syscall (posix-error-syscall posix-error)))
+     (format stream "~s ~s ~s ~s"
+             (or syscall "[No syscall name]")
+             (or code "[No code]") identifier
+             (or (strerror code) "[Can't get error string.]")))))
 
 ;;;; string.h
 

diff --git a/posix/early.lisp b/posix/early.lisp
index fa53d4f..88167d7 100644 (file)
--- a/posix/early.lisp
+++ b/posix/early.lisp
@@ -36,7 +36,8 @@
 ;;; in basic-unix.lisp because it needs %STRERROR-R defined later in
 ;;; wrappers.lisp.
 (define-condition posix-error (system-error)
-  ((object :initform nil :initarg :object :reader posix-error-object))
+  ((object :initform nil :initarg :object :reader posix-error-object)
+   (syscall :initform nil :initarg :syscall :reader posix-error-syscall))
   (:documentation
    "POSIX-ERRORs are signalled whenever ERRNO is set by a POSIX call."))
 
@@ -65,7 +66,7 @@
 ;;; Instantiates a subclass of POSIX-ERROR matching ERR or a plain
 ;;; POSIX-ERROR if no matching subclass is found.  ERR can be either a
 ;;; keyword or an integer both denoting an ERRNO value.
-(defun make-posix-error (err object)
+(defun make-posix-error (err object syscall)
   (let (error-keyword error-code)
     (etypecase err
       (keyword (setf error-keyword err)
@@ -74,24 +75,27 @@
                                        :unknown))
                (setf error-code err)))
     (if-let (condition-class (get-posix-error-condition error-keyword))
-            (make-condition condition-class :object object)
+            (make-condition condition-class
+                            :object object
+                            :syscall syscall)
             (make-condition 'posix-error
                             :object object
                             :code error-code
-                            :identifier error-keyword))))
+                            :identifier error-keyword
+                            :syscall syscall))))
 
 ;;; This might be a silly question but, who resets ERRNO?  Should we?
 ;;; I ask because we have some function bindings with DEFSYSCALL that
 ;;; have no documented ERRNO behaviour and we're checking ERRNO when
 ;;; they fail anyway.  --luis
 
-(defun posix-error (&optional (errno (get-errno)) object)
-  (error (make-posix-error errno object)))
+(defun posix-error (&optional (errno (get-errno)) object syscall)
+  (error (make-posix-error errno object syscall)))
 
 ;;; Default ERROR-GENERATOR for ERRNO-WRAPPER.
-(defun syscall-signal-posix-error (return-value object)
+(defun syscall-signal-posix-error (return-value object syscall)
   (declare (ignore return-value))
-  (posix-error (get-errno) object))
+  (posix-error (get-errno) object syscall))
 
 ;;; Error predicate that always returns NIL.  Not actually used
 ;;; because the ERRNO-WRAPPER optimizes this call away.
@@ -112,7 +116,8 @@
    (return-filter :initarg :return-filter :reader return-filter)
    (error-generator :initarg :error-generator :reader error-generator)
    (base-type :initarg :base-type :reader base-type)
-   (object :initarg :object :reader errno-object)))
+   (object :initarg :object :reader errno-object)
+   (function-name :initarg :function-name :reader function-name)))
 
 ;;; FIXME: undocumented in cffi-grovel.
 (defun make-from-pointer-function-name (type-name)
@@ -120,7 +125,8 @@
 
 (define-parse-method errno-wrapper
     (base-type &key object error-predicate (return-filter 'identity)
-               (error-generator 'syscall-signal-posix-error))
+               (error-generator 'syscall-signal-posix-error)
+               function-name)
   ;; pick a default error-predicate
   (unless error-predicate
     (case base-type
@@ -148,7 +154,8 @@
                  :base-type base-type
                  :error-predicate error-predicate
                  :return-filter return-filter
-                 :error-generator error-generator))
+                 :error-generator error-generator
+                 :function-name function-name))
 
 ;;; This type translator sets up the appropriate calls to
 ;;; RETURN-FILTER, ERROR-PREDICATE and ERROR-GENERATOR around the
@@ -164,7 +171,8 @@
             (if (eq (error-predicate type) 'never-fails)
                 return-exp
                 `(if (,(error-predicate type) r)
-                     (,(error-generator type) r ,(errno-object type))
+                     (,(error-generator type) r ,(errno-object type)
+                       ',(function-name type))
                      ,return-exp))))))
 
 (defmacro defsyscall (name-and-opts return-type &body args)
@@ -174,11 +182,15 @@ the C function name."
   (multiple-value-bind (lisp-name c-name options)
       (cffi::parse-name-and-options name-and-opts)
     #+windows (setf c-name (concatenate 'string "_" c-name))
-    `(defcfun (,c-name ,lisp-name ,@options) (errno-wrapper ,return-type)
+    `(defcfun (,c-name ,lisp-name ,@options)
+         (errno-wrapper ,return-type :function-name ,lisp-name)
        ,@args)))
 
 ;;; This workaround for windows sucks. --luis
 (defmacro defcsyscall (name-and-opts return-type &body args)
   "Like DEFSYSCALL but doesn't prepend #\_ to the C function name on
 windows (or any other platform)."
-  `(defcfun ,name-and-opts (errno-wrapper ,return-type) ,@args))
+  (let ((lisp-name (cffi::parse-name-and-options name-and-opts)))
+    `(defcfun ,name-and-opts
+         (errno-wrapper ,return-type :function-name ,lisp-name)
+       ,@args)))

diff --git a/posix/packages.lisp b/posix/packages.lisp
index e022979..53f81c9 100644 (file)
--- a/posix/packages.lisp
+++ b/posix/packages.lisp
@@ -37,6 +37,7 @@
    ;; Conditions
    #:posix-error
    #:posix-error-object
+   #:posix-error-syscall
 
    #:eperm #:enoent #:esrch #:eintr #:eio #:enxio #:e2big #:enoexec #:ebadf
    #:echild #:eagain #:enomem #:eacces #:efault #:enotblk #:ebusy #:eexist

diff --git a/tests/posix.lisp b/tests/posix.lisp
index bdc8c02..ee1e3bf 100644 (file)
--- a/tests/posix.lisp
+++ b/tests/posix.lisp
@@ -626,3 +626,9 @@
           (nix:close fd)
           (nix:unlink non-link-pathname))))
   failed)
+
+(define-posix-test posix-error-syscall
+    (handler-case (nix:mkdir "/" 0)
+      (nix:posix-error (c)
+        (nix:posix-error-syscall c)))
+  nix:mkdir)
\ No newline at end of file