From b676e19acf37e14e5a0eb1db150c4d9d3c25c9fc Mon Sep 17 00:00:00 2001
From: Xavier Clerc <xavier.clerc@inria.fr>
Date: Wed, 10 Oct 2012 08:54:42 +0000
Subject: PR#5240: register exception printers for Unix.Unix_error and
 Dynlink.Error

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@12996 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
---
 otherlibs/unix/unix.ml | 77 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 77 insertions(+)

(limited to 'otherlibs/unix/unix.ml')

diff --git a/otherlibs/unix/unix.ml b/otherlibs/unix/unix.ml
index 0adc41e21..211de46ab 100644
--- a/otherlibs/unix/unix.ml
+++ b/otherlibs/unix/unix.ml
@@ -91,6 +91,83 @@ let _ = Callback.register_exception "Unix.Unix_error"
 
 external error_message : error -> string = "unix_error_message"
 
+let () =
+  Printexc.register_printer
+    (function
+      | Unix_error (e, s, s') ->
+	  let msg = match e with
+	  | E2BIG -> "E2BIG"
+	  | EACCES -> "EACCES"
+	  | EAGAIN -> "EAGAIN"
+	  | EBADF -> "EBADF"
+	  | EBUSY -> "EBUSY"
+	  | ECHILD -> "ECHILD"
+	  | EDEADLK -> "EDEADLK"
+	  | EDOM -> "EDOM"
+	  | EEXIST -> "EEXIST"
+	  | EFAULT -> "EFAULT"
+	  | EFBIG -> "EFBIG"
+	  | EINTR -> "EINTR"
+	  | EINVAL -> "EINVAL"
+	  | EIO -> "EIO"
+	  | EISDIR -> "EISDIR"
+	  | EMFILE -> "EMFILE"
+	  | EMLINK -> "EMLINK"
+	  | ENAMETOOLONG -> "ENAMETOOLONG"
+	  | ENFILE -> "ENFILE"
+	  | ENODEV -> "ENODEV"
+	  | ENOENT -> "ENOENT"
+	  | ENOEXEC -> "ENOEXEC"
+	  | ENOLCK -> "ENOLCK"
+	  | ENOMEM -> "ENOMEM"
+	  | ENOSPC -> "ENOSPC"
+	  | ENOSYS -> "ENOSYS"
+	  | ENOTDIR -> "ENOTDIR"
+	  | ENOTEMPTY -> "ENOTEMPTY"
+	  | ENOTTY -> "ENOTTY"
+	  | ENXIO -> "ENXIO"
+	  | EPERM -> "EPERM"
+	  | EPIPE -> "EPIPE"
+	  | ERANGE -> "ERANGE"
+	  | EROFS -> "EROFS"
+	  | ESPIPE -> "ESPIPE"
+	  | ESRCH -> "ESRCH"
+	  | EXDEV -> "EXDEV"
+	  | EWOULDBLOCK -> "EWOULDBLOCK"
+	  | EINPROGRESS -> "EINPROGRESS"
+	  | EALREADY -> "EALREADY"
+	  | ENOTSOCK -> "ENOTSOCK"
+	  | EDESTADDRREQ -> "EDESTADDRREQ"
+	  | EMSGSIZE -> "EMSGSIZE"
+	  | EPROTOTYPE -> "EPROTOTYPE"
+	  | ENOPROTOOPT -> "ENOPROTOOPT"
+	  | EPROTONOSUPPORT -> "EPROTONOSUPPORT"
+	  | ESOCKTNOSUPPORT -> "ESOCKTNOSUPPORT"
+	  | EOPNOTSUPP -> "EOPNOTSUPP"
+	  | EPFNOSUPPORT -> "EPFNOSUPPORT"
+	  | EAFNOSUPPORT -> "EAFNOSUPPORT"
+	  | EADDRINUSE -> "EADDRINUSE"
+	  | EADDRNOTAVAIL -> "EADDRNOTAVAIL"
+	  | ENETDOWN -> "ENETDOWN"
+	  | ENETUNREACH -> "ENETUNREACH"
+	  | ENETRESET -> "ENETRESET"
+	  | ECONNABORTED -> "ECONNABORTED"
+	  | ECONNRESET -> "ECONNRESET"
+	  | ENOBUFS -> "ENOBUFS"
+	  | EISCONN -> "EISCONN"
+	  | ENOTCONN -> "ENOTCONN"
+	  | ESHUTDOWN -> "ESHUTDOWN"
+	  | ETOOMANYREFS -> "ETOOMANYREFS"
+	  | ETIMEDOUT -> "ETIMEDOUT"
+	  | ECONNREFUSED -> "ECONNREFUSED"
+	  | EHOSTDOWN -> "EHOSTDOWN"
+	  | EHOSTUNREACH -> "EHOSTUNREACH"
+	  | ELOOP -> "ELOOP"
+	  | EOVERFLOW -> "EOVERFLOW"
+	  | EUNKNOWNERR x -> Printf.sprintf "EUNKNOWNERR %d" x in
+	  Some (Printf.sprintf "Unix.Unix_error(Unix.%s, %S, %S)" msg s s')
+      | _ -> None)
+
 let handle_unix_error f arg =
   try
     f arg
-- 
cgit v1.2.3-70-g09d2