[m-rev.] for review: Introduce io.system_error to io.m public interface.

Peter Wang novalazy at gmail.com
Tue Aug 23 15:23:56 AEST 2022


On Mon, 22 Aug 2022 22:00:53 +1000 Julien Fischer <jfischer at opturion.com> wrote:
> 
> Hi Peter,
> 
> On Mon, 22 Aug 2022, Peter Wang wrote:
> 
> > Implement the error handling proposals from February and August 2022
> > on the mercury-users list.
> 
> Actually, the August discussion was on the reviews list.

Fixed.

> > diff --git a/library/io.m b/library/io.m
> > index acf43f53e..0123f8cb1 100644
> > --- a/library/io.m
> > +++ b/library/io.m
> > @@ -130,7 +130,20 @@
> >     ;       eof
> >     ;       error(string, int). % error message, line number
> > 
> > -:- type io.error.   % Use error_message to decode it.
> > +    % A value indicating an error.
> 
>        an I/O error.
> 
> > +    % This may or may not have an associated io.system_error value.
> > +    %
> > +:- type io.error.
> > +
> > +    % A system-dependent error value.
> > +    % For C backends, this is either an errno value (e.g. ENOENT)
> > +    % or a Windows system error code (e.g. ERROR_FILE_NOT_FOUND).
> > +    % For the Java and C# backends, this is an exception object.
> > +    %
> > +:- type system_error.
> > +:- pragma foreign_type(c, system_error, "MR_Integer").
> 
> You can set can_pass_as_mercury_type on that.
> (The existing code should have done that.)
> 

Done.

> > +:- pragma foreign_type("C#", system_error, "System.Exception").
> > +:- pragma foreign_type(java, system_error, "java.lang.Exception").
> >
> >     % whence denotes the base for a seek operation.
> >     %   set - seek relative to the start of the file
> > @@ -2044,15 +2057,61 @@
> > % Interpreting I/O error messages.
> > %
> > 
> > -    % Construct an error code including the specified error message.
> > +    % Construct an error value with the specified error message.
> > +    % The error value will not have an associated system error.
> >     %
> > :- func make_io_error(string) = io.error.
> > 
> > -    % Look up the error message corresponding to a particular error code.
> > +    % Return an error message for the error value.
> >     %
> > :- func error_message(io.error) = string.
> > :- pred error_message(io.error::in, string::out) is det.
> 
> These will now need to take the I/O state. strerror and FormatMessage depend
> on the current locale. That's going to breaking change, although I think we can
> live with that, given that most calls to error_message occur in contexts where
> the I/O state is available anyway.
> 
> Same goes for bunch of things in the implementation.
> e.g system_error_errno_message, system_error_win32_error_message -- basically
> anything that leads to call to strerror or FormatMessage.
> 

Oh, I forgot about that.

I don't want to break io.error_message as that would break a lot of code
to fix basically a theoretical problem. In practice either no one cares
about locales, or sets the locale once at the start of a program.

I'd prefer if io.error_message and co. were made independent of the
current locale. strerror_l() exists but isn't available everywhere yet.

I'm going to revert the changes, and retrieve the system error message
at the time that the io.error is constructed (with the I/O state).
Deferring retrieving the error message is a minor optimisation at most.

> > +    % get_system_error(Error, SystemError):
> > +    %
> > +    % Succeeds iff SystemError is a system error associated with Error.
> > +    %
> > +:- pred get_system_error(io.error::in, io.system_error::out) is semidet.
> > +
> > +    % As above, but only succeeds if the system error is an errno value.
> > +    %
> > +:- pred get_errno_error(io.error::in, io.system_error::out) is semidet.
> > +
> > +    % As above, but only succeeds if the system error is a Windows error code.
> > +    % XXX ERROR: should this refer to "Win32" error codes instead?
> 
> Based on the blurb at the start of their API documentation, Microsoft would
> _really_ like you to call it the Windows API, except for all of the places where
> they still refer to it as the Win32 API ;-)  I think just Windows is fine.
> 

Ok.

> > +:- pred get_windows_error(io.error::in, io.system_error::out) is semidet.
> > +
> > +    % As above, but only if the system error is a C# or Java exception object.
> > +    % XXX ERROR: how to name this?
> > +    %
> > +:- pred get_error_exception_object(io.error::in, io.system_error::out)
> > +    is semidet.
> 
> Given that all the other names have the form get_N_error, I suggest either
> 
>     get_exception_error
> 
> or:
> 
>     get_exception_object_error
> 

I've changed it to get_exception_object_error.

> 
> > +    % get_system_error_name(Error, ErrorName):
> > +    %
> > +    % Succeeds if Error has an associated system error, otherwise fails.
> > +    % On success, ErrorName is a name for that system error as follows.
> > +    %
> > +    % For C backends, a system error is usually an errno value. If the errno
> > +    % value is recognised by the Mercury system, then ErrorName will be the
> > +    % name for that errno value as defined in <errno.h>, e.g. "ENOENT".
> > +    % Otherwise, ErrorName will be "errno: N" where N is a decimal number.
> > +    %
> > +    % For C backends on Windows, a system error may instead be a Windows system
> > +    % error code. If the error code is recognised by the Mercury system, then
> > +    % ErrorName will be the name for that error code in the Win32 API,
> 
> s/Win32/Windows/
> 

Fixed.

> > +    % e.g. "ERROR_FILE_NOT_FOUND". Otherwise, ErrorName will be
> > +    % "System error: 0xN" where 0xN is a hexadecimal number.
> > +    %
> > +    % For the C# backend, ErrorName will be the the fully qualified class name
> 
> Double "the"
> 

Fixed.

I think we should remove the colon in the fallback strings.
Log messages like:

    unable to foobar: errno 123
    unable to foobar: System error 0x123

look a bit better and less confusing without the extra colon.

> > -    % make_err_msg(Error, MessagePrefix, Message, !IO):
> > -    % Message is an error message obtained by looking up the message for the
> > -    % given errno value and prepending MessagePrefix.
> > +    % Make an io.error from a message prefix and system error.
> > +    % On Windows, the system error is assumed to be a errno value.
> >     %
> > -:- pred make_err_msg(system_error::in, string::in, string::out,
> > -    io::di, io::uo) is det.
> > +:- func make_io_error_from_system_error(string, io.system_error) = io.error.
> > 
> > -    % make_maybe_win32_err_msg(Error, MessagePrefix, Message, !IO):
> > +    % Make an io.error from a message prefix and system error.
> > +    % On Windows, the system error is assumed to be a Windows system error
> > +    % code.
> 
> I would add: obtained by calling GetLastError().

Done.

> > +%---------------------%
> > +
> > +    % XXX is FormatMessage thread-safe? Nothing suggests that it is not.
> 
> That information really ought to be easier to find than it apparently is :-(
> 
> > +    %
> > +:- pred system_error_win32_error_message(io.system_error::in, string::out)
> > +    is det.
> > +
> > +:- pragma foreign_proc("C",
> > +    system_error_win32_error_message(ErrorCode::in, Name::out),
> > +    [will_not_call_mercury, promise_pure, thread_safe, may_not_export_body],
> > +"
> 
> ...
> 
> > diff --git a/runtime/mercury_win32_error_name.c b/runtime/mercury_win32_error_name.c
> > new file mode 100644
> > index 000000000..72755462a
> > --- /dev/null
> > +++ b/runtime/mercury_win32_error_name.c
> 
> ...
> 
> > diff --git a/runtime/mercury_win32_error_name.h b/runtime/mercury_win32_error_name.h
> > new file mode 100644
> > index 000000000..318dc2e8f
> 
> I would be inclined to name these mercury_windows_error_name.[ch].

Done.

Interdiff follows. I've cut out some uninteresting changes.

Peter


diff --git a/library/io.m b/library/io.m
index 0123f8cb1..3c739aa64 100644
--- a/library/io.m
+++ b/library/io.m
@@ -141,7 +141,8 @@
     % For the Java and C# backends, this is an exception object.
     %
 :- type system_error.
-:- pragma foreign_type(c, system_error, "MR_Integer").
+:- pragma foreign_type(c, system_error, "MR_Integer",
+    [can_pass_as_mercury_type]).
 :- pragma foreign_type("C#", system_error, "System.Exception").
 :- pragma foreign_type(java, system_error, "java.lang.Exception").
 
@@ -2078,14 +2079,12 @@
 :- pred get_errno_error(io.error::in, io.system_error::out) is semidet.
 
     % As above, but only succeeds if the system error is a Windows error code.
-    % XXX ERROR: should this refer to "Win32" error codes instead?
     %
 :- pred get_windows_error(io.error::in, io.system_error::out) is semidet.
 
     % As above, but only if the system error is a C# or Java exception object.
-    % XXX ERROR: how to name this?
     %
-:- pred get_error_exception_object(io.error::in, io.system_error::out)
+:- pred get_exception_object_error(io.error::in, io.system_error::out)
     is semidet.
 
     % get_system_error_name(Error, ErrorName):
@@ -2096,15 +2095,15 @@
     % For C backends, a system error is usually an errno value. If the errno
     % value is recognised by the Mercury system, then ErrorName will be the
     % name for that errno value as defined in <errno.h>, e.g. "ENOENT".
-    % Otherwise, ErrorName will be "errno: N" where N is a decimal number.
+    % Otherwise, ErrorName will be "errno N" where N is a decimal number.
     %
     % For C backends on Windows, a system error may instead be a Windows system
     % error code. If the error code is recognised by the Mercury system, then
-    % ErrorName will be the name for that error code in the Win32 API,
+    % ErrorName will be the name for that error code in the Windows API,
     % e.g. "ERROR_FILE_NOT_FOUND". Otherwise, ErrorName will be
-    % "System error: 0xN" where 0xN is a hexadecimal number.
+    % "System error 0xN" where 0xN is a hexadecimal number.
     %
-    % For the C# backend, ErrorName will be the the fully qualified class name
+    % For the C# backend, ErrorName will be the fully qualified class name
     % of an exception object, e.g. "System.IO.FileNotFoundException".
     %
     % For the Java backend, ErrorName will be the fully qualified class name
@@ -2266,28 +2265,30 @@
 % Error handling.
 %
 
-    % is_error(Error, MessagePrefix, MaybeIOError):
+    % is_error(Error, MessagePrefix, MaybeIOError, !IO):
     % Returns `yes(IOError)' if Error indicates an error (not success).
     %
-:- pred is_error(system_error::in, string::in, maybe(io.error)::out) is det.
+:- pred is_error(system_error::in, string::in, maybe(io.error)::out,
+    io::di, io::uo) is det.
 
-    % is_maybe_win32_error(Error, MessagePrefix, MaybeIOError):
+    % is_maybe_win32_error(Error, MessagePrefix, MaybeIOError, !IO):
     % Same as is_error except that Error is a Win32 error value on Windows.
     %
 :- pred is_maybe_win32_error(system_error::in, string::in,
-    maybe(io.error)::out) is det.
+    maybe(io.error)::out, io::di, io::uo) is det.
 
-    % Make an io.error from a message prefix and system error.
+    % Make an io.error from a system error and message prefix.
     % On Windows, the system error is assumed to be a errno value.
     %
-:- func make_io_error_from_system_error(string, io.system_error) = io.error.
+:- pred make_io_error_from_system_error(io.system_error::in, string::in,
+    io.error::out, io::di, io::uo) is det.
 
-    % Make an io.error from a message prefix and system error.
+    % Make an io.error from a system error and message prefix.
     % On Windows, the system error is assumed to be a Windows system error
-    % code.
+    % code obtained by calling GetLastError().
     %
-:- func make_io_error_from_maybe_win32_error(string, io.system_error) =
-    io.error.
+:- pred make_io_error_from_maybe_win32_error(io.system_error::in, string::in,
+    io.error::out, io::di, io::uo) is det.
 
     % For use by bitmap.m, and other standard library modules
     % that want to do I/O.
@@ -2418,7 +2419,7 @@ io_state_compare(_, _, _) :-
 
 open_input(FileName, Result, !IO) :-
     do_open_text(FileName, "r", OpenCount, NewStream, Error, !IO),
-    is_error(Error, "can't open input file: ", MaybeIOError),
+    is_error(Error, "can't open input file: ", MaybeIOError, !IO),
     (
         MaybeIOError = yes(IOError),
         Result = error(IOError)
@@ -2431,7 +2432,7 @@ open_input(FileName, Result, !IO) :-
 
 open_binary_input(FileName, Result, !IO) :-
     do_open_binary(FileName, "rb", OpenCount, NewStream, Error, !IO),
-    is_error(Error, "can't open input file: ", MaybeIOError),
+    is_error(Error, "can't open input file: ", MaybeIOError, !IO),
     (
         MaybeIOError = yes(IOError),
         Result = error(IOError)
@@ -2446,7 +2447,7 @@ open_binary_input(FileName, Result, !IO) :-
 
 open_output(FileName, Result, !IO) :-
     do_open_text(FileName, "w", OpenCount, NewStream, Error, !IO),
-    is_error(Error, "can't open output file: ", MaybeIOError),
+    is_error(Error, "can't open output file: ", MaybeIOError, !IO),
     (
         MaybeIOError = yes(IOError),
         Result = error(IOError)
@@ -2459,7 +2460,7 @@ open_output(FileName, Result, !IO) :-
 
 open_binary_output(FileName, Result, !IO) :-
     do_open_binary(FileName, "wb", OpenCount, NewStream, Error, !IO),
-    is_error(Error, "can't open output file: ", MaybeIOError),
+    is_error(Error, "can't open output file: ", MaybeIOError, !IO),
     (
         MaybeIOError = yes(IOError),
         Result = error(IOError)
@@ -2474,7 +2475,7 @@ open_binary_output(FileName, Result, !IO) :-
 
 open_append(FileName, Result, !IO) :-
     do_open_text(FileName, "a", OpenCount, NewStream, Error, !IO),
-    is_error(Error, "can't append to file: ", MaybeIOError),
+    is_error(Error, "can't append to file: ", MaybeIOError, !IO),
     (
         MaybeIOError = yes(IOError),
         Result = error(IOError)
@@ -2487,7 +2488,7 @@ open_append(FileName, Result, !IO) :-
 
 open_binary_append(FileName, Result, !IO) :-
     do_open_binary(FileName, "ab", OpenCount, NewStream, Error, !IO),
-    is_error(Error, "can't append to file: ", MaybeIOError),
+    is_error(Error, "can't append to file: ", MaybeIOError, !IO),
     (
         MaybeIOError = yes(IOError),
         Result = error(IOError)
@@ -3483,7 +3484,7 @@ read_line(Stream, Result, !IO) :-
         Result = eof
     ;
         ResultCode = result_code_error,
-        IOError = make_io_error_from_system_error("read failed: ", Error),
+        make_io_error_from_system_error(Error, "read failed: ", IOError, !IO),
         Result = error(IOError)
     ).
 
@@ -3504,7 +3505,7 @@ read_line_as_string(input_stream(Stream), Result, !IO) :-
         Result = error(io_error_string("null character in input"))
     ;
         Res = rlas_error,
-        IOError = make_io_error_from_system_error("read failed: ", Error),
+        make_io_error_from_system_error(Error, "read failed: ", IOError, !IO),
         Result = error(IOError)
     ).
 
@@ -3997,7 +3998,7 @@ read_file_as_string(Result, !IO) :-
 
 read_file_as_string(input_stream(Stream), Result, !IO) :-
     read_file_as_string_2(Stream, String, _NumCUs, Error, NullCharError, !IO),
-    is_error(Error, "read failed: ", MaybeIOError),
+    is_error(Error, "read failed: ", MaybeIOError, !IO),
     (
         MaybeIOError = yes(IOError),
         Result = error(String, IOError)
@@ -4018,7 +4019,7 @@ read_file_as_string_and_num_code_units(Result, !IO) :-
 
 read_file_as_string_and_num_code_units(input_stream(Stream), Result, !IO) :-
     read_file_as_string_2(Stream, String, NumCUs, Error, NullCharError, !IO),
-    is_error(Error, "read failed: ", MaybeIOError),
+    is_error(Error, "read failed: ", MaybeIOError, !IO),
     (
         MaybeIOError = yes(IOError),
         Result = error2(String, NumCUs, IOError)
@@ -4894,71 +4895,16 @@ report_tabling_statistics(!IO) :-
     ;       io_error_win32(string, system_error)
     ;       io_error_exception_object(string, system_error).
 
-:- type system_error_style
-    --->    syserr_errno
-    ;       syserr_errno_or_win32
-    ;       syserr_exception_object.
-
-:- pragma foreign_export_enum("C", system_error_style/0,
-    [prefix("ML_"), uppercase]).
-:- pragma foreign_export_enum("C#", system_error_style/0,
-    [prefix("ML_"), uppercase]).
-:- pragma foreign_export_enum("Java", system_error_style/0,
-    [prefix("ML_"), uppercase]).
-
-:- func native_system_error_style = system_error_style.
-
-:- pragma foreign_proc("C",
-    native_system_error_style = (SysErrStyle::out),
-    [will_not_call_mercury, promise_pure, thread_safe],
-"
-#ifdef MR_WIN32
-    SysErrStyle = ML_SYSERR_ERRNO_OR_WIN32;
-#else
-    SysErrStyle = ML_SYSERR_ERRNO;
-#endif
-").
-:- pragma foreign_proc("C#",
-    native_system_error_style = (SysErrStyle::out),
-    [will_not_call_mercury, promise_pure, thread_safe],
-"
-    SysErrStyle = io.ML_SYSERR_EXCEPTION_OBJECT;
-").
-:- pragma foreign_proc("Java",
-    native_system_error_style = (SysErrStyle::out),
-    [will_not_call_mercury, promise_pure, thread_safe],
-"
-    SysErrStyle = jmercury.io.ML_SYSERR_EXCEPTION_OBJECT;
-").
-
-%---------------------%
-
 make_io_error(Error) = io_error_string(Error).
 
-%---------------------%
-
 error_message(Error) = Msg :-
     error_message(Error, Msg).
 
 error_message(Error, Msg) :-
-    (
-        Error = io_error_string(Msg)
-    ;
-        (
-            Error = io_error_errno(Prefix, Errno),
-            system_error_errno_message(Errno, Msg0)
-        ;
-            Error = io_error_win32(Prefix, ErrorCode),
-            system_error_win32_error_message(ErrorCode, Msg0)
-        ;
-            Error = io_error_exception_object(Prefix, Exception),
-            system_error_exception_message(Exception, Msg0)
-        ),
-        ( if Prefix = "" then
-            Msg = Msg0
-        else
-            Msg = Prefix ++ Msg0
-        )
+    ( Error = io_error_string(Msg)
+    ; Error = io_error_errno(Msg, _)
+    ; Error = io_error_win32(Msg, _)
+    ; Error = io_error_exception_object(Msg, _)
     ).
 
 %---------------------%
@@ -4977,7 +4923,7 @@ get_errno_error(Error, Errno) :-
 get_windows_error(Error, ErrorCode) :-
     Error = io_error_win32(_, ErrorCode).
 
-get_error_exception_object(Error, Exception) :-
+get_exception_object_error(Error, Exception) :-
     Error = io_error_exception_object(_, Exception).
 
 %---------------------%
@@ -5010,7 +4956,7 @@ get_system_error_name(Error, Name) :-
     if (str != NULL) {
         Name = (MR_String) str;
     } else {
-        Name = MR_make_string(MR_ALLOC_ID, ""errno: %d"", Errno);
+        Name = MR_make_string(MR_ALLOC_ID, ""errno %d"", Errno);
     }
 ").
 
@@ -5019,24 +4965,6 @@ system_error_errno_name(_, _) :-
 
 %---------------------%
 
-:- pred system_error_errno_message(io.system_error::in, string::out) is det.
-
-:- pragma foreign_proc("C",
-    system_error_errno_message(Errno::in, Msg::out),
-    [will_not_call_mercury, promise_pure, thread_safe, may_not_export_body],
-"
-    char        errbuf[MR_STRERROR_BUF_SIZE];
-    const char  *errno_msg;
-
-    errno_msg = MR_strerror(Errno, errbuf, sizeof(errbuf));
-    MR_make_aligned_string_copy_msg(Msg, errno_msg, MR_ALLOC_ID);
-").
-
-system_error_errno_message(_, _) :-
-    error("io.system_error_errno_message: inapplicable back-end").
-
-%---------------------%
-
 :- pred system_error_win32_error_name(io.system_error::in, string::out) is det.
 
 :- pragma foreign_proc("C",
@@ -5048,7 +4976,7 @@ system_error_errno_message(_, _) :-
     if (str != NULL) {
         Name = (MR_String) str;
     } else {
-        Name = MR_make_string(MR_ALLOC_ID, ""System error: 0x%X"", ErrorCode);
+        Name = MR_make_string(MR_ALLOC_ID, ""System error 0x%X"", ErrorCode);
     }
 #else
     MR_fatal_error(""io.system_error_win32_error_name: not on Windows"");
@@ -5058,49 +4986,6 @@ system_error_errno_message(_, _) :-
 system_error_win32_error_name(_, _) :-
     error("io.system_error_win32_error_name: inapplicable back-end").
 
-%---------------------%
-
-    % XXX is FormatMessage thread-safe? Nothing suggests that it is not.
-    %
-:- pred system_error_win32_error_message(io.system_error::in, string::out)
-    is det.
-
-:- pragma foreign_proc("C",
-    system_error_win32_error_message(ErrorCode::in, Name::out),
-    [will_not_call_mercury, promise_pure, thread_safe, may_not_export_body],
-"
-#ifdef MR_WIN32
-    LPVOID  err_buf;
-
-    if (FormatMessage(
-            FORMAT_MESSAGE_ALLOCATE_BUFFER
-            | FORMAT_MESSAGE_FROM_SYSTEM
-            | FORMAT_MESSAGE_IGNORE_INSERTS,
-            NULL,
-            ErrorCode,
-            MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
-            (LPTSTR) &err_buf,
-            0,
-            NULL) > 0)
-    {
-        // Remove trailing CR LF sequence.
-        char *cr = strchr(err_buf, '\\r');
-        if (cr != NULL) {
-            *cr = '\\0';
-        }
-        MR_make_aligned_string_copy_msg(Name, err_buf, MR_ALLOC_ID);
-        LocalFree(err_buf);
-    } else {
-        Name = MR_make_string(MR_ALLOC_ID, ""System error: 0x%X"", ErrorCode);
-    }
-#else
-    MR_fatal_error(""io.system_error_win32_error_message: not on Windows"");
-#endif
-").
-
-system_error_win32_error_message(_, _) :-
-    error("io.system_error_win32_error_message: inapplicable back-end").
-
 %---------------------%
 
 :- pred system_error_exception_name(io.system_error::in, string::out) is det.
@@ -5121,29 +5006,6 @@ system_error_win32_error_message(_, _) :-
 system_error_exception_name(_, _) :-
     error("io.system_error_exception_name: inapplicable back-end").
 
-%---------------------%
-
-:- pred system_error_exception_message(io.system_error::in, string::out) is det.
-
-:- pragma foreign_proc("C#",
-    system_error_exception_message(Exception::in, Msg::out),
-    [will_not_call_mercury, promise_pure, thread_safe, may_not_export_body],
-"
-    Msg = Exception.Message;
-").
-:- pragma foreign_proc("Java",
-    system_error_exception_message(Exception::in, Msg::out),
-    [will_not_call_mercury, promise_pure, thread_safe, may_not_export_body],
-"
-    Msg = Exception.getMessage();
-    if (Msg == null) {
-        Msg = ""null"";
-    }
-").
-
-system_error_exception_message(_, _) :-
-    error("io.system_error_exception_message: inapplicable back-end").
-
 %---------------------------------------------------------------------------%
 %---------------------------------------------------------------------------%
 %
@@ -5354,7 +5216,7 @@ compare_file_id_2(_, _, _) :-
 
 file_id(FileName, Result, !IO) :-
     file_id_2(FileName, FileId, Error, !IO),
-    is_error(Error, "cannot get file id: ", MaybeIOError),
+    is_error(Error, "cannot get file id: ", MaybeIOError, !IO),
     (
         MaybeIOError = yes(IOError),
         Result = error(IOError)
@@ -5859,7 +5721,7 @@ interpret_result_code0(ResultCode, Error, Result, !IO) :-
         Result = eof
     ;
         ResultCode = result_code_error,
-        IOError = make_io_error_from_system_error("read failed: ", Error),
+        make_io_error_from_system_error(Error, "read failed: ", IOError, !IO),
         Result = error(IOError)
     ).
 
@@ -5876,7 +5738,7 @@ interpret_result_code1(ResultCode, Error, Value, Result, !IO) :-
         Result = eof
     ;
         ResultCode = result_code_error,
-        IOError = make_io_error_from_system_error("read failed: ", Error),
+        make_io_error_from_system_error(Error, "read failed: ", IOError, !IO),
         Result = error(IOError)
     ).
 
@@ -5913,12 +5775,51 @@ interpret_maybe_incomplete_result_code(ResultCode, Error, IncompleteBytes,
         Result = incomplete(IncompleteBytes)
     ;
         ResultCode = mirc_error,
-        IOError = make_io_error_from_system_error("read failed: ", Error),
+        make_io_error_from_system_error(Error, "read failed: ", IOError, !IO),
         Result = error(IOError)
     ).
 
 %---------------------%
 
+:- type system_error_style
+    --->    syserr_errno
+    ;       syserr_errno_or_win32
+    ;       syserr_exception_object.
+
+:- pragma foreign_export_enum("C", system_error_style/0,
+    [prefix("ML_"), uppercase]).
+:- pragma foreign_export_enum("C#", system_error_style/0,
+    [prefix("ML_"), uppercase]).
+:- pragma foreign_export_enum("Java", system_error_style/0,
+    [prefix("ML_"), uppercase]).
+
+:- func native_system_error_style = system_error_style.
+
+:- pragma foreign_proc("C",
+    native_system_error_style = (SysErrStyle::out),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+#ifdef MR_WIN32
+    SysErrStyle = ML_SYSERR_ERRNO_OR_WIN32;
+#else
+    SysErrStyle = ML_SYSERR_ERRNO;
+#endif
+").
+:- pragma foreign_proc("C#",
+    native_system_error_style = (SysErrStyle::out),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    SysErrStyle = io.ML_SYSERR_EXCEPTION_OBJECT;
+").
+:- pragma foreign_proc("Java",
+    native_system_error_style = (SysErrStyle::out),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    SysErrStyle = jmercury.io.ML_SYSERR_EXCEPTION_OBJECT;
+").
+
+%---------------------%
+
 :- func no_error = system_error.
 
 :- pragma foreign_proc("C",
@@ -5966,51 +5867,66 @@ interpret_maybe_incomplete_result_code(ResultCode, Error, IncompleteBytes,
     SUCCESS_INDICATOR = (Error == null);
 ").
 
-is_error(Error, Prefix, MaybeError) :-
+is_error(Error, Prefix, MaybeError, !IO) :-
     ( if is_success(Error) then
         MaybeError = no
     else
-        IOError = make_io_error_from_system_error(Prefix, Error),
+        make_io_error_from_system_error(Error, Prefix, IOError, !IO),
         MaybeError = yes(IOError)
     ).
 
-is_maybe_win32_error(Error, Prefix, MaybeError) :-
+is_maybe_win32_error(Error, Prefix, MaybeError, !IO) :-
     ( if is_success(Error) then
         MaybeError = no
     else
-        IOError = make_io_error_from_maybe_win32_error(Prefix, Error),
+        make_io_error_from_maybe_win32_error(Error, Prefix, IOError, !IO),
         MaybeError = yes(IOError)
     ).
 
-make_io_error_from_system_error(Error, Prefix) = IOError :-
+make_io_error_from_system_error(Error, Prefix, IOError, !IO) :-
     SysErrStyle = native_system_error_style,
     (
         ( SysErrStyle = syserr_errno
         ; SysErrStyle = syserr_errno_or_win32
         ),
-        IOError = io_error_errno(Error, Prefix)
+        make_errno_message(Error, Prefix, Msg, !IO),
+        IOError = io_error_errno(Msg, Error)
     ;
         SysErrStyle = syserr_exception_object,
-        IOError = io_error_exception_object(Error, Prefix)
+        get_exception_object_message(Error, Msg0, !IO),
+        ( if Prefix = "" then
+            Msg = Msg0
+        else
+            Msg = Prefix ++ Msg0
+        ),
+        IOError = io_error_exception_object(Msg, Error)
     ).
 
-make_io_error_from_maybe_win32_error(Prefix, Error) = IOError :-
+make_io_error_from_maybe_win32_error(Error, Prefix, IOError, !IO) :-
     SysErrStyle = native_system_error_style,
     (
         SysErrStyle = syserr_errno,
-        IOError = io_error_errno(Prefix, Error)
+        make_errno_message(Error, Prefix, Msg, !IO),
+        IOError = io_error_errno(Msg, Error)
     ;
         SysErrStyle = syserr_errno_or_win32,
-        IOError = io_error_win32(Prefix, Error)
+        make_win32_error_message(Error, Prefix, Msg, !IO),
+        IOError = io_error_win32(Msg, Error)
     ;
         SysErrStyle = syserr_exception_object,
-        IOError = io_error_exception_object(Prefix, Error)
+        get_exception_object_message(Error, Msg0, !IO),
+        ( if Prefix = "" then
+            Msg = Msg0
+        else
+            Msg = Prefix ++ Msg0
+        ),
+        IOError = io_error_exception_object(Msg, Error)
     ).
 
 :- pred throw_on_error(system_error::in, string::in, io::di, io::uo) is det.
 
 throw_on_error(Error, Prefix, !IO) :-
-    is_error(Error, Prefix, MaybeIOError),
+    is_error(Error, Prefix, MaybeIOError, !IO),
     (
         MaybeIOError = yes(IOError),
         throw(IOError)
@@ -6026,6 +5942,118 @@ throw_on_output_error(Error, !IO) :-
 throw_on_close_error(Error, !IO) :-
     throw_on_error(Error, "error closing file: ", !IO).
 
+%---------------------------------------------------------------------------%
+
+    % This requires the I/O state because the strerror/strerror_r functions
+    % depend on the current locale.
+    %
+:- pred make_errno_message(io.system_error::in, string::in, string::out,
+    io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+    make_errno_message(Errno::in, Prefix::in, Msg::out, _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_not_export_body],
+"
+    char        errbuf[MR_STRERROR_BUF_SIZE];
+    const char  *errmsg;
+    size_t      errmsg_len;
+    size_t      prefix_len;
+
+    prefix_len = strlen(Prefix);
+    errmsg = MR_strerror(Errno, errbuf, sizeof(errbuf));
+    errmsg_len = strlen(errmsg);
+    MR_allocate_aligned_string_msg(Msg, prefix_len + errmsg_len, MR_ALLOC_ID);
+    MR_memcpy(Msg, Prefix, prefix_len);
+    MR_memcpy(Msg + prefix_len, errmsg, errmsg_len + 1); // include NUL
+").
+
+make_errno_message(_, _, _, !IO) :-
+    error("io.make_errno_message: inapplicable back-end").
+
+%---------------------%
+
+    % This requires the I/O state because the FormatMessage call depends
+    % on the current locale.
+    %
+    % XXX is FormatMessage thread-safe? Nothing suggests that it is not.
+    %
+:- pred make_win32_error_message(io.system_error::in, string::in, string::out,
+    io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+    make_win32_error_message(ErrorCode::in, Prefix::in, Msg::out,
+        _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_not_export_body],
+"
+#ifdef MR_WIN32
+    char    *errmsg;
+    size_t  errmsg_len;
+    size_t  prefix_len;
+
+    if (FormatMessage(
+            FORMAT_MESSAGE_ALLOCATE_BUFFER
+            | FORMAT_MESSAGE_FROM_SYSTEM
+            | FORMAT_MESSAGE_IGNORE_INSERTS,
+            NULL,
+            ErrorCode,
+            MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
+            (LPTSTR) &errmsg,
+            0,
+            NULL) > 0)
+    {
+        // Remove trailing CR LF sequence.
+        char *cr = strchr(errmsg, '\\r');
+        if (cr != NULL) {
+            *cr = '\\0';
+            errmsg_len = (size_t) (cr - errmsg);
+        } else {
+            errmsg_len = strlen(errmsg);
+        }
+        prefix_len = strlen(Prefix);
+        MR_allocate_aligned_string_msg(Msg, prefix_len + errmsg_len,
+            MR_ALLOC_ID);
+        MR_memcpy(Msg, Prefix, prefix_len);
+        MR_memcpy(Msg + prefix_len, errmsg, errmsg_len + 1); // include NUL
+        LocalFree(errmsg);
+    } else {
+        Msg = MR_make_string(MR_ALLOC_ID, ""%sSystem error 0x%X"",
+            Prefix, ErrorCode);
+    }
+#else
+    MR_fatal_error(""io.make_win32_error_message: not on Windows"");
+#endif
+").
+
+make_win32_error_message(_, _, _, !IO) :-
+    error("io.make_win32_error_message: inapplicable back-end").
+
+%---------------------%
+
+    % This requires the I/O state because the exception message may be
+    % localised (at least for C#).
+    %
+:- pred get_exception_object_message(io.system_error::in, string::out,
+    io::di, io::uo) is det.
+
+:- pragma foreign_proc("C#",
+    get_exception_object_message(Exception::in, Msg::out, _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_not_export_body],
+"
+    Msg = Exception.Message;
+").
+:- pragma foreign_proc("Java",
+    get_exception_object_message(Exception::in, Msg::out, _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, may_not_export_body],
+"
+    Msg = Exception.getMessage();
+    if (Msg == null) {
+        Msg = ""null"";
+    }
+").
+
+get_exception_object_message(_, _, !IO) :-
+    error("io.get_exception_object_message: inapplicable back-end").
+
 %---------------------------------------------------------------------------%
 
 :- pragma foreign_decl("C", "
@@ -6048,7 +6076,7 @@ throw_on_close_error(Error, !IO) :-
 #include ""mercury_misc.h""
 #include ""mercury_runtime_util.h""
 #include ""mercury_report_stats.h""
-#include ""mercury_win32_error_name.h""
+#include ""mercury_windows_error_name.h""
 
 #include <stdio.h>
 #include <stdlib.h>
diff --git a/runtime/Mmakefile b/runtime/Mmakefile
index 7ccdc26d4..d28fbbe42 100644
--- a/runtime/Mmakefile
+++ b/runtime/Mmakefile
@@ -108,8 +108,8 @@ HDRS = \
 	mercury_typeclass_info.h		\
 	mercury_types.h				\
 	mercury_univ.h				\
-	mercury_win32_error_name.h		\
 	mercury_windows.h			\
+	mercury_windows_error_name.h		\
 	mercury_wrapper.h			\
 	mercury_wsdeque.h
 
@@ -220,7 +220,7 @@ CFILES = \
 	mercury_type_desc.c			\
 	mercury_type_info.c			\
 	mercury_type_tables.c			\
-	mercury_win32_error_name.c		\
+	mercury_windows_error_name.c		\
 	mercury_wrapper.c			\
 	mercury_wsdeque.c
 
@@ -350,8 +350,8 @@ mercury_method_call_codes.i: ../tools/make_spec_method_call
 # mercury_errno_name.c: ../tools/generate_errno_name
 #	../tools/generate_errno_name > mercury_errno_name.c
 
-# mercury_win32_error_name.c: ../tools/generate_win32_error_name
-# 	../tools/generate_win32_error_name > mercury_win32_error_name.c
+# mercury_windows_error_name.c: ../tools/generate_windows_error_name
+#	../tools/generate_windows_error_name > mercury_windows_error_name.c
 
 #-----------------------------------------------------------------------------#


More information about the reviews mailing list