diff --git a/posix/basic-unix.lisp b/posix/basic-unix.lisp index fcc16e713b7b4995c3f1f95fc963cc677d2f6987..756fec96d95c6838675414d8f5eecb3af02d7de2 100644 --- 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 fa53d4f73aa685a0a5ba8b75215b85ace8f663a0..88167d7477694dcb9c73be1cba6ec92bb35e8519 100644 --- 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 e022979ce8dc11107732a124d2bd2d15b2b077a8..53f81c9728bfa8eb441d22a3920176ebc2f4b50b 100644 --- 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 bdc8c0232afa63ff6f18150d1506005c643f58d8..ee1e3bf050e26d32eb6c43cf3660f1f3cb912326 100644 --- 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