1.0.13.2: Removing UNIX-NAMESTRING, part 3 (sort of)

* Add condition classes to SB-POSIX that are subclasses of FILE-ERROR,
  to give more precise information than vanilla FILE-ERRORs after
  users load SB-POSIX.

* Add code to sb-grovel in support of same.

diff --git a/contrib/sb-grovel/def-to-lisp.lisp b/contrib/sb-grovel/def-to-lisp.lisp
index aa13f2e..7549b86 100644 (file)
--- a/contrib/sb-grovel/def-to-lisp.lisp
+++ b/contrib/sb-grovel/def-to-lisp.lisp
@@ -112,10 +112,12 @@ code:
     (dolist (def definitions)
       (destructuring-bind (type lispname cname &optional doc export) def
         (case type
-          (:integer
+          ((:integer :errno)
            (as-c "#ifdef" cname)
            (printf "(cl:defconstant ~A %d \"~A\")" lispname doc
                    cname)
+           (when (eql type :errno)
+             (printf "(cl:setf (get '~A 'errno) t)" lispname))
            (as-c "#else")
            (printf "(sb-int:style-warn \"Couldn't grovel for ~A (unknown to the C compiler).\")" cname)
            (as-c "#endif"))

diff --git a/contrib/sb-posix/constants.lisp b/contrib/sb-posix/constants.lisp
index 5b4f65b..0243a85 100644 (file)
--- a/contrib/sb-posix/constants.lisp
+++ b/contrib/sb-posix/constants.lisp
@@ -85,129 +85,129 @@
  (:integer SIGRTMAX "SIGRTMAX" #+sb-doc "Largest real-time signal number." t)
 
  ;; error numbers
- (:integer eperm "EPERM" nil t)
- (:integer enoent "ENOENT" nil t)
- (:integer esrch "ESRCH" nil t)
- (:integer eintr "EINTR" nil t)
- (:integer eio "EIO" nil t)
- (:integer enxio "ENXIO" nil t)
- (:integer e2big "E2BIG" nil t)
- (:integer enoexec "ENOEXEC" nil t)
- (:integer ebadf "EBADF" nil t)
- (:integer echild "ECHILD" nil t)
- (:integer eagain "EAGAIN" nil t)
- (:integer enomem "ENOMEM" nil t)
- (:integer eacces "EACCES" nil t)
- (:integer efault "EFAULT" nil t)
- (:integer enotblk "ENOTBLK" nil t)
- (:integer ebusy "EBUSY" nil t)
- (:integer eexist "EEXIST" nil t)
- (:integer exdev "EXDEV" nil t)
- (:integer enodev "ENODEV" nil t)
- (:integer enotdir "ENOTDIR" nil t)
- (:integer eisdir "EISDIR" nil t)
- (:integer einval "EINVAL" nil t)
- (:integer enfile "ENFILE" nil t)
- (:integer emfile "EMFILE" nil t)
- (:integer enotty "ENOTTY" nil t)
- (:integer etxtbsy "ETXTBSY" nil t)
- (:integer efbig "EFBIG" nil t)
- (:integer enospc "ENOSPC" nil t)
- (:integer espipe "ESPIPE" nil t)
- (:integer erofs "EROFS" nil t)
- (:integer emlink "EMLINK" nil t)
- (:integer epipe "EPIPE" nil t)
- (:integer edom "EDOM" nil t)
- (:integer erange "ERANGE" nil t)
- (:integer edeadlk "EDEADLK" nil t)
- (:integer enametoolong "ENAMETOOLONG" nil t)
- (:integer enolck "ENOLCK" nil t)
- (:integer enosys "ENOSYS" nil t)
- (:integer enotempty "ENOTEMPTY" nil t)
- (:integer eloop "ELOOP" nil t)
- (:integer ewouldblock "EWOULDBLOCK" nil t)
- (:integer enomsg "ENOMSG" nil t)
- (:integer eidrm "EIDRM" nil t)
- (:integer echrng "ECHRNG" nil t)
- (:integer el2nsync "EL2NSYNC" nil t)
- (:integer el3hlt "EL3HLT" nil t)
- (:integer el3rst "EL3RST" nil t)
- (:integer elnrng "ELNRNG" nil t)
- (:integer eunatch "EUNATCH" nil t)
- (:integer enocsi "ENOCSI" nil t)
- (:integer el2hlt "EL2HLT" nil t)
- (:integer ebade "EBADE" nil t)
- (:integer ebadr "EBADR" nil t)
- (:integer exfull "EXFULL" nil t)
- (:integer enoano "ENOANO" nil t)
- (:integer ebadrqc "EBADRQC" nil t)
- (:integer ebadslt "EBADSLT" nil t)
- (:integer edeadlock "EDEADLOCK" nil t)
- (:integer ebfont "EBFONT" nil t)
- (:integer enostr "ENOSTR" nil t)
- (:integer enodata "ENODATA" nil t)
- (:integer etime "ETIME" nil t)
- (:integer enosr "ENOSR" nil t)
- (:integer enonet "ENONET" nil t)
- (:integer enopkg "ENOPKG" nil t)
- (:integer eremote "EREMOTE" nil t)
- (:integer enolink "ENOLINK" nil t)
- (:integer eadv "EADV" nil t)
- (:integer esrmnt "ESRMNT" nil t)
- (:integer ecomm "ECOMM" nil t)
- (:integer eproto "EPROTO" nil t)
- (:integer emultihop "EMULTIHOP" nil t)
- (:integer edotdot "EDOTDOT" nil t)
- (:integer ebadmsg "EBADMSG" nil t)
- (:integer eoverflow "EOVERFLOW" nil t)
- (:integer enotuniq "ENOTUNIQ" nil t)
- (:integer ebadfd "EBADFD" nil t)
- (:integer eremchg "EREMCHG" nil t)
- (:integer elibacc "ELIBACC" nil t)
- (:integer elibbad "ELIBBAD" nil t)
- (:integer elibscn "ELIBSCN" nil t)
- (:integer elibmax "ELIBMAX" nil t)
- (:integer elibexec "ELIBEXEC" nil t)
- (:integer eilseq "EILSEQ" nil t)
- (:integer erestart "ERESTART" nil t)
- (:integer estrpipe "ESTRPIPE" nil t)
- (:integer eusers "EUSERS" nil t)
- (:integer enotsock "ENOTSOCK" nil t)
- (:integer edestaddrreq "EDESTADDRREQ" nil t)
- (:integer emsgsize "EMSGSIZE" nil t)
- (:integer eprototype "EPROTOTYPE" nil t)
- (:integer enoprotoopt "ENOPROTOOPT" nil t)
- (:integer eprotonosupport "EPROTONOSUPPORT" nil t)
- (:integer esocktnosupport "ESOCKTNOSUPPORT" nil t)
- (:integer eopnotsupp "EOPNOTSUPP" nil t)
- (:integer epfnosupport "EPFNOSUPPORT" nil t)
- (:integer eafnosupport "EAFNOSUPPORT" nil t)
- (:integer eaddrinuse "EADDRINUSE" nil t)
- (:integer eaddrnotavail "EADDRNOTAVAIL" nil t)
- (:integer enetdown "ENETDOWN" nil t)
- (:integer enetunreach "ENETUNREACH" nil t)
- (:integer enetreset "ENETRESET" nil t)
- (:integer econnaborted "ECONNABORTED" nil t)
- (:integer econnreset "ECONNRESET" nil t)
- (:integer enobufs "ENOBUFS" nil t)
- (:integer eisconn "EISCONN" nil t)
- (:integer enotconn "ENOTCONN" nil t)
- (:integer eshutdown "ESHUTDOWN" nil t)
- (:integer etoomanyrefs "ETOOMANYREFS" nil t)
- (:integer etimedout "ETIMEDOUT" nil t)
- (:integer econnrefused "ECONNREFUSED" nil t)
- (:integer ehostdown "EHOSTDOWN" nil t)
- (:integer ehostunreach "EHOSTUNREACH" nil t)
- (:integer ealready "EALREADY" nil t)
- (:integer einprogress "EINPROGRESS" nil t)
- (:integer estale "ESTALE" nil t)
- (:integer euclean "EUCLEAN" nil t)
- (:integer enotnam "ENOTNAM" nil t)
- (:integer enavail "ENAVAIL" nil t)
- (:integer eremoteio "EREMOTEIO" nil t)
- (:integer edquot "EDQUOT" nil t)
- (:integer enomedium "ENOMEDIUM" nil t)
- (:integer emediumtype "EMEDIUMTYPE" nil t)
+ (:errno eperm "EPERM" nil t)
+ (:errno enoent "ENOENT" nil t)
+ (:errno esrch "ESRCH" nil t)
+ (:errno eintr "EINTR" nil t)
+ (:errno eio "EIO" nil t)
+ (:errno enxio "ENXIO" nil t)
+ (:errno e2big "E2BIG" nil t)
+ (:errno enoexec "ENOEXEC" nil t)
+ (:errno ebadf "EBADF" nil t)
+ (:errno echild "ECHILD" nil t)
+ (:errno eagain "EAGAIN" nil t)
+ (:errno enomem "ENOMEM" nil t)
+ (:errno eacces "EACCES" nil t)
+ (:errno efault "EFAULT" nil t)
+ (:errno enotblk "ENOTBLK" nil t)
+ (:errno ebusy "EBUSY" nil t)
+ (:errno eexist "EEXIST" nil t)
+ (:errno exdev "EXDEV" nil t)
+ (:errno enodev "ENODEV" nil t)
+ (:errno enotdir "ENOTDIR" nil t)
+ (:errno eisdir "EISDIR" nil t)
+ (:errno einval "EINVAL" nil t)
+ (:errno enfile "ENFILE" nil t)
+ (:errno emfile "EMFILE" nil t)
+ (:errno enotty "ENOTTY" nil t)
+ (:errno etxtbsy "ETXTBSY" nil t)
+ (:errno efbig "EFBIG" nil t)
+ (:errno enospc "ENOSPC" nil t)
+ (:errno espipe "ESPIPE" nil t)
+ (:errno erofs "EROFS" nil t)
+ (:errno emlink "EMLINK" nil t)
+ (:errno epipe "EPIPE" nil t)
+ (:errno edom "EDOM" nil t)
+ (:errno erange "ERANGE" nil t)
+ (:errno edeadlk "EDEADLK" nil t)
+ (:errno enametoolong "ENAMETOOLONG" nil t)
+ (:errno enolck "ENOLCK" nil t)
+ (:errno enosys "ENOSYS" nil t)
+ (:errno enotempty "ENOTEMPTY" nil t)
+ (:errno eloop "ELOOP" nil t)
+ (:errno ewouldblock "EWOULDBLOCK" nil t)
+ (:errno enomsg "ENOMSG" nil t)
+ (:errno eidrm "EIDRM" nil t)
+ (:errno echrng "ECHRNG" nil t)
+ (:errno el2nsync "EL2NSYNC" nil t)
+ (:errno el3hlt "EL3HLT" nil t)
+ (:errno el3rst "EL3RST" nil t)
+ (:errno elnrng "ELNRNG" nil t)
+ (:errno eunatch "EUNATCH" nil t)
+ (:errno enocsi "ENOCSI" nil t)
+ (:errno el2hlt "EL2HLT" nil t)
+ (:errno ebade "EBADE" nil t)
+ (:errno ebadr "EBADR" nil t)
+ (:errno exfull "EXFULL" nil t)
+ (:errno enoano "ENOANO" nil t)
+ (:errno ebadrqc "EBADRQC" nil t)
+ (:errno ebadslt "EBADSLT" nil t)
+ (:errno edeadlock "EDEADLOCK" nil t)
+ (:errno ebfont "EBFONT" nil t)
+ (:errno enostr "ENOSTR" nil t)
+ (:errno enodata "ENODATA" nil t)
+ (:errno etime "ETIME" nil t)
+ (:errno enosr "ENOSR" nil t)
+ (:errno enonet "ENONET" nil t)
+ (:errno enopkg "ENOPKG" nil t)
+ (:errno eremote "EREMOTE" nil t)
+ (:errno enolink "ENOLINK" nil t)
+ (:errno eadv "EADV" nil t)
+ (:errno esrmnt "ESRMNT" nil t)
+ (:errno ecomm "ECOMM" nil t)
+ (:errno eproto "EPROTO" nil t)
+ (:errno emultihop "EMULTIHOP" nil t)
+ (:errno edotdot "EDOTDOT" nil t)
+ (:errno ebadmsg "EBADMSG" nil t)
+ (:errno eoverflow "EOVERFLOW" nil t)
+ (:errno enotuniq "ENOTUNIQ" nil t)
+ (:errno ebadfd "EBADFD" nil t)
+ (:errno eremchg "EREMCHG" nil t)
+ (:errno elibacc "ELIBACC" nil t)
+ (:errno elibbad "ELIBBAD" nil t)
+ (:errno elibscn "ELIBSCN" nil t)
+ (:errno elibmax "ELIBMAX" nil t)
+ (:errno elibexec "ELIBEXEC" nil t)
+ (:errno eilseq "EILSEQ" nil t)
+ (:errno erestart "ERESTART" nil t)
+ (:errno estrpipe "ESTRPIPE" nil t)
+ (:errno eusers "EUSERS" nil t)
+ (:errno enotsock "ENOTSOCK" nil t)
+ (:errno edestaddrreq "EDESTADDRREQ" nil t)
+ (:errno emsgsize "EMSGSIZE" nil t)
+ (:errno eprototype "EPROTOTYPE" nil t)
+ (:errno enoprotoopt "ENOPROTOOPT" nil t)
+ (:errno eprotonosupport "EPROTONOSUPPORT" nil t)
+ (:errno esocktnosupport "ESOCKTNOSUPPORT" nil t)
+ (:errno eopnotsupp "EOPNOTSUPP" nil t)
+ (:errno epfnosupport "EPFNOSUPPORT" nil t)
+ (:errno eafnosupport "EAFNOSUPPORT" nil t)
+ (:errno eaddrinuse "EADDRINUSE" nil t)
+ (:errno eaddrnotavail "EADDRNOTAVAIL" nil t)
+ (:errno enetdown "ENETDOWN" nil t)
+ (:errno enetunreach "ENETUNREACH" nil t)
+ (:errno enetreset "ENETRESET" nil t)
+ (:errno econnaborted "ECONNABORTED" nil t)
+ (:errno econnreset "ECONNRESET" nil t)
+ (:errno enobufs "ENOBUFS" nil t)
+ (:errno eisconn "EISCONN" nil t)
+ (:errno enotconn "ENOTCONN" nil t)
+ (:errno eshutdown "ESHUTDOWN" nil t)
+ (:errno etoomanyrefs "ETOOMANYREFS" nil t)
+ (:errno etimedout "ETIMEDOUT" nil t)
+ (:errno econnrefused "ECONNREFUSED" nil t)
+ (:errno ehostdown "EHOSTDOWN" nil t)
+ (:errno ehostunreach "EHOSTUNREACH" nil t)
+ (:errno ealready "EALREADY" nil t)
+ (:errno einprogress "EINPROGRESS" nil t)
+ (:errno estale "ESTALE" nil t)
+ (:errno euclean "EUCLEAN" nil t)
+ (:errno enotnam "ENOTNAM" nil t)
+ (:errno enavail "ENAVAIL" nil t)
+ (:errno eremoteio "EREMOTEIO" nil t)
+ (:errno edquot "EDQUOT" nil t)
+ (:errno enomedium "ENOMEDIUM" nil t)
+ (:errno emediumtype "EMEDIUMTYPE" nil t)
 
  ;; wait
  (:integer wnohang "WNOHANG")

diff --git a/contrib/sb-posix/interface.lisp b/contrib/sb-posix/interface.lisp
index cef0c71..541c3c9 100644 (file)
--- a/contrib/sb-posix/interface.lisp
+++ b/contrib/sb-posix/interface.lisp
@@ -63,9 +63,78 @@
                (format s "System call error ~A (~A)"
                        errno (sb-int:strerror errno))))))
 
-(defun syscall-error ()
-  (error 'sb-posix:syscall-error :errno (get-errno)))
+(defvar *errno-table*
+  (let ((errno-max 0)
+        list)
+    (do-symbols (symbol (find-package "SB-POSIX"))
+      (when (get symbol 'errno)
+        (let ((errno (symbol-value symbol)))
+          (setf errno-max (max errno  errno-max))
+          (push (cons errno
+                      (eval `(define-condition ,symbol (syscall-error) ())))
+                list))))
+    (let ((table (make-array (1+ errno-max))))
+      (mapc #'(lambda (cons) (setf (elt table (car cons)) (cdr cons))) list)
+      table)))
 
+(defun syscall-error ()
+  (let ((errno (get-errno)))
+    (error (elt *errno-table* errno) :errno errno)))
+
+;; Note that we inherit from SIMPLE-FILE-ERROR first, to get its
+;; error reporting, rather than SYSCALL-ERROR's.
+(define-condition file-syscall-error
+    (sb-impl::simple-file-error syscall-error)
+  ())
+
+(defvar *file-errno-table*
+  (let ((array (copy-seq *errno-table*)))
+    (map-into array
+              (lambda (condition-class-name)
+                (if (symbolp condition-class-name)
+                    (let ((file-condition-name
+                           (read-from-string
+                            (format nil "FILE-~A" condition-class-name))))
+                      ;; Should condition class names like FILE-ENOENT
+                      ;; and FILE-ENOTDIR be exported?  I want to say
+                      ;; "no", since we already export ENOENT, ENOTDIR
+                      ;; et al, and so the user can write handlers
+                      ;; such as
+                      ;;
+                      ;;  (handler-bind ((sb-posix:enoent ...)
+                      ;;                 (sb-posix:enotdir ...)
+                      ;;                 (file-error ...))
+                      ;;    ...)
+                      ;;
+                      ;; which will do the right thing for all our
+                      ;; FILE-SYSCALL-ERRORs, without exposing this
+                      ;; implementation detail.  (Recall that some
+                      ;; FILE-ERRORs don't strictly have to do with
+                      ;; the file system, e.g., supplying a wild
+                      ;; pathname to some functions.)  But if the
+                      ;; prevailing opinion is otherwise, uncomment
+                      ;; the following.
+                      #| (export file-condition-name) |#
+                      (eval `(define-condition ,file-condition-name
+                                 (,condition-class-name file-syscall-error)
+                               ())))
+                    condition-class-name))
+              array)
+    array))
+
+;; Note: do we have to declare SIMPLE-FILE-PERROR notinline in
+;; fd-stream.lisp?
+(sb-ext:without-package-locks
+  (defun sb-impl::simple-file-perror (note-format pathname errno)
+    (error (elt *file-errno-table* errno)
+           :pathname pathname
+           :errno errno
+           :format-control "~@<~?: ~2I~_~A~:>"
+           :format-arguments
+           (list note-format (list pathname) (sb-int:strerror errno)))))
+
+;; Note: it might prove convenient to develop a parallel set of
+;; condition classes for STREAM-ERRORs, too.
 (declaim (inline never-fails))
 (defun never-fails (&rest args)
   (declare (ignore args))

diff --git a/version.lisp-expr b/version.lisp-expr
index 1084087..8b0291a 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.13.1"
+"1.0.13.2"