diff options
| -rw-r--r-- | Changes | 1 | ||||
| -rw-r--r-- | otherlibs/dynlink/dynlink.ml | 30 | ||||
| -rw-r--r-- | otherlibs/unix/unix.ml | 77 |
3 files changed, 108 insertions, 0 deletions
@@ -39,6 +39,7 @@ OCaml 4.00.2: ------------- Bug fixes: +- PR#5240: register exception printers for Unix.Unix_error and Dynlink.Error - PR#5772: problem with marshaling of mutually-recursive functions diff --git a/otherlibs/dynlink/dynlink.ml b/otherlibs/dynlink/dynlink.ml index ee136fe2c..b0fcba654 100644 --- a/otherlibs/dynlink/dynlink.ml +++ b/otherlibs/dynlink/dynlink.ml @@ -36,6 +36,36 @@ type error = exception Error of error +let () = + Printexc.register_printer + (function + | Error err -> + let msg = match err with + | Not_a_bytecode_file s -> + Printf.sprintf "Not_a_bytecode_file %S" s + | Inconsistent_import s -> + Printf.sprintf "Inconsistent_import %S" s + | Unavailable_unit s -> + Printf.sprintf "Unavailable_unit %S" s + | Unsafe_file -> + "Unsafe_file" + | Linking_error (s, Undefined_global s') -> + Printf.sprintf "Linking_error (%S, Dynlink.Undefined_global %S)" s s' + | Linking_error (s, Unavailable_primitive s') -> + Printf.sprintf "Linking_error (%S, Dynlink.Unavailable_primitive %S)" s s' + | Linking_error (s, Uninitialized_global s') -> + Printf.sprintf "Linking_error (%S, Dynlink.Uninitialized_global %S)" s s' + | Corrupted_interface s -> + Printf.sprintf "Corrupted_interface %S" s + | File_not_found s -> + Printf.sprintf "File_not_found %S" s + | Cannot_open_dll s -> + Printf.sprintf "Cannot_open_dll %S" s + | Inconsistent_implementation s -> + Printf.sprintf "Inconsistent_implementation %S" s in + Some (Printf.sprintf "Dynlink.Error(Dynlink.%s)" msg) + | _ -> None) + (* Management of interface CRCs *) let crc_interfaces = ref (Consistbl.create ()) 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 |