mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 09:23:44 +00:00
336 lines
11 KiB
Mathematica
336 lines
11 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 2023-2025 The Mercury team.
|
|
% This file is distributed under the terms specified in COPYING.LIB.
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% File: io.error_util.m.
|
|
% Stability: high.
|
|
%
|
|
% This module provides some predicates for dealing with I/O errors.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module io.error_util.
|
|
:- interface.
|
|
|
|
:- func no_error = system_error.
|
|
|
|
% 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,
|
|
io::di, io::uo) is det.
|
|
|
|
% is_error_maybe_win32(Error, IsWin32Error, MessagePrefix, MaybeIOError,
|
|
% !IO):
|
|
%
|
|
% Same as is_error except that IsWin32Error is `yes' if Error originates
|
|
% from a Win32 system error code, `no' otherwise.
|
|
%
|
|
:- pred is_error_maybe_win32(system_error::in, bool::in, string::in,
|
|
maybe(io.error)::out, io::di, io::uo) is det.
|
|
|
|
:- pred make_io_error_from_system_error_impl(io.system_error::in, string::in,
|
|
io.error::out, io::di, io::uo) is det.
|
|
|
|
:- pred make_io_error_from_windows_error_impl(io.system_error::in, string::in,
|
|
io.error::out, io::di, io::uo) is det.
|
|
|
|
% make_io_error_from_maybe_win32_error(Error, IsWin32Error, Prefix,
|
|
% IOError, !IO):
|
|
%
|
|
% Helper to call either make_io_error_from_system_error_impl or
|
|
% make_io_error_from_windows_error_impl.
|
|
%
|
|
:- pred make_io_error_from_maybe_win32_error(system_error::in, bool::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.
|
|
%
|
|
:- pred throw_on_output_error(system_error::in, io::di, io::uo) is det.
|
|
|
|
:- pred throw_on_close_error(system_error::in, io::di, io::uo) is det.
|
|
|
|
:- pred throw_on_error(system_error::in, string::in, io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- 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__error_util.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__error_util.ML_SYSERR_EXCEPTION_OBJECT;
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
no_error = (Error::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
Error = 0;
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
no_error = (Error::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
Error = null;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
no_error = (Error::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
Error = null;
|
|
").
|
|
|
|
:- pragma inline(pred(is_error/5)).
|
|
|
|
is_error(Error, Prefix, MaybeError, !IO) :-
|
|
( if system_error_is_success(Error) then
|
|
MaybeError = no
|
|
else
|
|
make_io_error_from_system_error_impl(Error, Prefix, IOError, !IO),
|
|
MaybeError = yes(IOError)
|
|
).
|
|
|
|
is_error_maybe_win32(Error, IsWin32Error, Prefix, MaybeError, !IO) :-
|
|
( if system_error_is_success(Error) then
|
|
MaybeError = no
|
|
else
|
|
make_io_error_from_maybe_win32_error(Error, IsWin32Error, Prefix,
|
|
IOError, !IO),
|
|
MaybeError = yes(IOError)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
make_io_error_from_system_error_impl(Error, Prefix, IOError, !IO) :-
|
|
SysErrStyle = native_system_error_style,
|
|
(
|
|
( SysErrStyle = syserr_errno
|
|
; SysErrStyle = syserr_errno_or_win32
|
|
),
|
|
make_errno_message(Error, Prefix, Msg, !IO),
|
|
IOError = io_error_errno(Msg, Error)
|
|
;
|
|
SysErrStyle = syserr_exception_object,
|
|
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_windows_error_impl(Error, Prefix, IOError, !IO) :-
|
|
SysErrStyle = native_system_error_style,
|
|
(
|
|
SysErrStyle = syserr_errno_or_win32,
|
|
make_win32_error_message(Error, Prefix, Msg, !IO),
|
|
IOError = io_error_win32(Msg, Error)
|
|
;
|
|
( SysErrStyle = syserr_errno
|
|
; SysErrStyle = syserr_exception_object
|
|
),
|
|
error("io.error_util.make_io_error_from_windows_error: " ++
|
|
"inapplicable platform")
|
|
).
|
|
|
|
make_io_error_from_maybe_win32_error(Error, IsWin32Error, Prefix, IOError,
|
|
!IO) :-
|
|
(
|
|
IsWin32Error = yes,
|
|
make_io_error_from_windows_error_impl(Error, Prefix, IOError, !IO)
|
|
;
|
|
IsWin32Error = no,
|
|
make_io_error_from_system_error_impl(Error, Prefix, IOError, !IO)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pragma inline(pred(throw_on_output_error/3)).
|
|
|
|
throw_on_output_error(Error, !IO) :-
|
|
throw_on_error(Error, "error writing to output file: ", !IO).
|
|
|
|
throw_on_close_error(Error, !IO) :-
|
|
throw_on_error(Error, "error closing file: ", !IO).
|
|
|
|
:- pragma inline(pred(throw_on_error/4)).
|
|
|
|
throw_on_error(Error, Prefix, !IO) :-
|
|
% This follows the logic of is_error, but does not construct
|
|
% a MaybeError as an intermediate data structure.
|
|
( if system_error_is_success(Error) then
|
|
true
|
|
else
|
|
make_io_error_from_system_error_impl(Error, Prefix, IOError, !IO),
|
|
throw(IOError)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% 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(_, _, _, _, _) :-
|
|
error("io.error_util.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.error_util.make_win32_error_message: not on Windows"");
|
|
#endif
|
|
").
|
|
|
|
make_win32_error_message(_, _, _, _, _) :-
|
|
error("io.error_util.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 no_determinism_warning(pred(get_exception_object_message/4)).
|
|
|
|
:- 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],
|
|
"
|
|
if (Exception == null) {
|
|
Msg = ""null"";
|
|
} else {
|
|
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],
|
|
"
|
|
if (Exception == null) {
|
|
Msg = ""null"";
|
|
} else {
|
|
Msg = Exception.getMessage();
|
|
if (Msg == null) {
|
|
Msg = ""null"";
|
|
}
|
|
}
|
|
").
|
|
|
|
get_exception_object_message(_, _, IO, IO) :-
|
|
error("io.error_util.get_exception_object_message: inapplicable back-end").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module io.error_util.
|
|
%---------------------------------------------------------------------------%
|