PR fortran/68401 Improve allocation error message
Improve the error message that is printed when a memory allocation fails, by including the location, and the size of the allocation that failed. Regtested on x86_64-pc-linux-gnu. gcc/fortran/ChangeLog: 2019-08-17 Janne Blomqvist <jb@gcc.gnu.org> PR fortran/68401 * trans-decl.c (gfc_build_builtin_function_decls): Replace os_error with os_error_at decl. * trans.c (trans_runtime_error_vararg): Modify so the error function decl is passed directly. (gfc_trans_runtime_error): Pass correct error function decl. (gfc_trans_runtime_check): Likewise. (trans_os_error_at): New function. (gfc_call_malloc): Use trans_os_error_at. (gfc_allocate_using_malloc): Likewise. (gfc_call_realloc): Likewise. * trans.h (gfor_fndecl_os_error): Replace with gfor_fndecl_os_error_at. libgfortran/ChangeLog: 2019-08-17 Janne Blomqvist <jb@gcc.gnu.org> PR fortran/68401 * gfortran.map: Add GFORTRAN_10 node, add _gfortran_os_error_at symbol. * libgfortran.h (os_error_at): New prototype. * runtime/error.c (os_error_at): New function. From-SVN: r274599
This commit is contained in:
Janne Blomqvist
parent
777c028252
commit
d74a8b0579
|
|
@ -1,3 +1,18 @@
|
|||
2019-08-17 Janne Blomqvist <jb@gcc.gnu.org>
|
||||
|
||||
PR fortran/68401
|
||||
* trans-decl.c (gfc_build_builtin_function_decls): Replace
|
||||
os_error with os_error_at decl.
|
||||
* trans.c (trans_runtime_error_vararg): Modify so the error
|
||||
function decl is passed directly.
|
||||
(gfc_trans_runtime_error): Pass correct error function decl.
|
||||
(gfc_trans_runtime_check): Likewise.
|
||||
(trans_os_error_at): New function.
|
||||
(gfc_call_malloc): Use trans_os_error_at.
|
||||
(gfc_allocate_using_malloc): Likewise.
|
||||
(gfc_call_realloc): Likewise.
|
||||
* trans.h (gfor_fndecl_os_error): Replace with gfor_fndecl_os_error_at.
|
||||
|
||||
2019-08-16 Jeff Law <law@redhat.com>
|
||||
Mark Eggleston <mark.eggleston@codethink.com>
|
||||
|
||||
|
|
@ -18,7 +33,7 @@
|
|||
* trans-common.c (find_equivalence) : New local variable dummy_symbol,
|
||||
accumulated equivalence attributes from each symbol then check for
|
||||
conflicts.
|
||||
|
||||
|
||||
2019-08-16 Richard Biener <rguenther@suse.de>
|
||||
|
||||
* trans-intrinsic.c (gfc_conv_intrinsic_findloc): Initialize
|
||||
|
|
|
|||
|
|
@ -102,7 +102,7 @@ tree gfor_fndecl_error_stop_string;
|
|||
tree gfor_fndecl_runtime_error;
|
||||
tree gfor_fndecl_runtime_error_at;
|
||||
tree gfor_fndecl_runtime_warning_at;
|
||||
tree gfor_fndecl_os_error;
|
||||
tree gfor_fndecl_os_error_at;
|
||||
tree gfor_fndecl_generate_error;
|
||||
tree gfor_fndecl_set_args;
|
||||
tree gfor_fndecl_set_fpe;
|
||||
|
|
@ -3679,11 +3679,11 @@ gfc_build_builtin_function_decls (void)
|
|||
void_type_node, 3, pvoid_type_node, integer_type_node,
|
||||
pchar_type_node);
|
||||
|
||||
gfor_fndecl_os_error = gfc_build_library_function_decl_with_spec (
|
||||
get_identifier (PREFIX("os_error")), ".R",
|
||||
void_type_node, 1, pchar_type_node);
|
||||
/* The runtime_error function does not return. */
|
||||
TREE_THIS_VOLATILE (gfor_fndecl_os_error) = 1;
|
||||
gfor_fndecl_os_error_at = gfc_build_library_function_decl_with_spec (
|
||||
get_identifier (PREFIX("os_error_at")), ".RR",
|
||||
void_type_node, -2, pchar_type_node, pchar_type_node);
|
||||
/* The os_error_at function does not return. */
|
||||
TREE_THIS_VOLATILE (gfor_fndecl_os_error_at) = 1;
|
||||
|
||||
gfor_fndecl_set_args = gfc_build_library_function_decl (
|
||||
get_identifier (PREFIX("set_args")),
|
||||
|
|
|
|||
|
|
@ -447,7 +447,7 @@ gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr)
|
|||
arguments and a locus. */
|
||||
|
||||
static tree
|
||||
trans_runtime_error_vararg (bool error, locus* where, const char* msgid,
|
||||
trans_runtime_error_vararg (tree errorfunc, locus* where, const char* msgid,
|
||||
va_list ap)
|
||||
{
|
||||
stmtblock_t block;
|
||||
|
|
@ -501,18 +501,13 @@ trans_runtime_error_vararg (bool error, locus* where, const char* msgid,
|
|||
/* Build the function call to runtime_(warning,error)_at; because of the
|
||||
variable number of arguments, we can't use build_call_expr_loc dinput_location,
|
||||
irectly. */
|
||||
if (error)
|
||||
fntype = TREE_TYPE (gfor_fndecl_runtime_error_at);
|
||||
else
|
||||
fntype = TREE_TYPE (gfor_fndecl_runtime_warning_at);
|
||||
fntype = TREE_TYPE (errorfunc);
|
||||
|
||||
loc = where ? where->lb->location : input_location;
|
||||
tmp = fold_build_call_array_loc (loc, TREE_TYPE (fntype),
|
||||
fold_build1_loc (loc, ADDR_EXPR,
|
||||
build_pointer_type (fntype),
|
||||
error
|
||||
? gfor_fndecl_runtime_error_at
|
||||
: gfor_fndecl_runtime_warning_at),
|
||||
errorfunc),
|
||||
nargs + 2, argarray);
|
||||
gfc_add_expr_to_block (&block, tmp);
|
||||
|
||||
|
|
@ -527,7 +522,10 @@ gfc_trans_runtime_error (bool error, locus* where, const char* msgid, ...)
|
|||
tree result;
|
||||
|
||||
va_start (ap, msgid);
|
||||
result = trans_runtime_error_vararg (error, where, msgid, ap);
|
||||
result = trans_runtime_error_vararg (error
|
||||
? gfor_fndecl_runtime_error_at
|
||||
: gfor_fndecl_runtime_warning_at,
|
||||
where, msgid, ap);
|
||||
va_end (ap);
|
||||
return result;
|
||||
}
|
||||
|
|
@ -566,8 +564,10 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
|
|||
/* The code to generate the error. */
|
||||
va_start (ap, msgid);
|
||||
gfc_add_expr_to_block (&block,
|
||||
trans_runtime_error_vararg (error, where,
|
||||
msgid, ap));
|
||||
trans_runtime_error_vararg
|
||||
(error ? gfor_fndecl_runtime_error_at
|
||||
: gfor_fndecl_runtime_warning_at,
|
||||
where, msgid, ap));
|
||||
va_end (ap);
|
||||
|
||||
if (once)
|
||||
|
|
@ -595,13 +595,28 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
|
|||
}
|
||||
|
||||
|
||||
static tree
|
||||
trans_os_error_at (locus* where, const char* msgid, ...)
|
||||
{
|
||||
va_list ap;
|
||||
tree result;
|
||||
|
||||
va_start (ap, msgid);
|
||||
result = trans_runtime_error_vararg (gfor_fndecl_os_error_at,
|
||||
where, msgid, ap);
|
||||
va_end (ap);
|
||||
return result;
|
||||
}
|
||||
|
||||
|
||||
|
||||
/* Call malloc to allocate size bytes of memory, with special conditions:
|
||||
+ if size == 0, return a malloced area of size 1,
|
||||
+ if malloc returns NULL, issue a runtime error. */
|
||||
tree
|
||||
gfc_call_malloc (stmtblock_t * block, tree type, tree size)
|
||||
{
|
||||
tree tmp, msg, malloc_result, null_result, res, malloc_tree;
|
||||
tree tmp, malloc_result, null_result, res, malloc_tree;
|
||||
stmtblock_t block2;
|
||||
|
||||
/* Create a variable to hold the result. */
|
||||
|
|
@ -626,13 +641,14 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size)
|
|||
null_result = fold_build2_loc (input_location, EQ_EXPR,
|
||||
logical_type_node, res,
|
||||
build_int_cst (pvoid_type_node, 0));
|
||||
msg = gfc_build_addr_expr (pchar_type_node,
|
||||
gfc_build_localized_cstring_const ("Memory allocation failed"));
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
|
||||
null_result,
|
||||
build_call_expr_loc (input_location,
|
||||
gfor_fndecl_os_error, 1, msg),
|
||||
build_empty_stmt (input_location));
|
||||
trans_os_error_at (NULL,
|
||||
"Error allocating %lu bytes",
|
||||
fold_convert
|
||||
(long_unsigned_type_node,
|
||||
size)),
|
||||
build_empty_stmt (input_location));
|
||||
gfc_add_expr_to_block (&block2, tmp);
|
||||
}
|
||||
|
||||
|
|
@ -701,11 +717,9 @@ gfc_allocate_using_malloc (stmtblock_t * block, tree pointer,
|
|||
}
|
||||
else
|
||||
{
|
||||
/* Here, os_error already implies PRED_NORETURN. */
|
||||
tmp = build_call_expr_loc (input_location, gfor_fndecl_os_error, 1,
|
||||
gfc_build_addr_expr (pchar_type_node,
|
||||
gfc_build_localized_cstring_const
|
||||
("Allocation would exceed memory limit")));
|
||||
/* Here, os_error_at already implies PRED_NORETURN. */
|
||||
tree lusize = fold_convert (long_unsigned_type_node, size);
|
||||
tmp = trans_os_error_at (NULL, "Error allocating %lu bytes", lusize);
|
||||
gfc_add_expr_to_block (&on_error, tmp);
|
||||
}
|
||||
|
||||
|
|
@ -1664,7 +1678,7 @@ internal_realloc (void *mem, size_t size)
|
|||
tree
|
||||
gfc_call_realloc (stmtblock_t * block, tree mem, tree size)
|
||||
{
|
||||
tree msg, res, nonzero, null_result, tmp;
|
||||
tree res, nonzero, null_result, tmp;
|
||||
tree type = TREE_TYPE (mem);
|
||||
|
||||
/* Only evaluate the size once. */
|
||||
|
|
@ -1684,12 +1698,12 @@ gfc_call_realloc (stmtblock_t * block, tree mem, tree size)
|
|||
build_int_cst (size_type_node, 0));
|
||||
null_result = fold_build2_loc (input_location, TRUTH_AND_EXPR, logical_type_node,
|
||||
null_result, nonzero);
|
||||
msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const
|
||||
("Allocation would exceed memory limit"));
|
||||
tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
|
||||
null_result,
|
||||
build_call_expr_loc (input_location,
|
||||
gfor_fndecl_os_error, 1, msg),
|
||||
trans_os_error_at (NULL,
|
||||
"Error reallocating to %lu bytes",
|
||||
fold_convert
|
||||
(long_unsigned_type_node, size)),
|
||||
build_empty_stmt (input_location));
|
||||
gfc_add_expr_to_block (block, tmp);
|
||||
|
||||
|
|
|
|||
|
|
@ -803,7 +803,7 @@ extern GTY(()) tree gfor_fndecl_error_stop_string;
|
|||
extern GTY(()) tree gfor_fndecl_runtime_error;
|
||||
extern GTY(()) tree gfor_fndecl_runtime_error_at;
|
||||
extern GTY(()) tree gfor_fndecl_runtime_warning_at;
|
||||
extern GTY(()) tree gfor_fndecl_os_error;
|
||||
extern GTY(()) tree gfor_fndecl_os_error_at;
|
||||
extern GTY(()) tree gfor_fndecl_generate_error;
|
||||
extern GTY(()) tree gfor_fndecl_set_fpe;
|
||||
extern GTY(()) tree gfor_fndecl_set_options;
|
||||
|
|
|
|||
|
|
@ -1,3 +1,11 @@
|
|||
2019-08-17 Janne Blomqvist <jb@gcc.gnu.org>
|
||||
|
||||
PR fortran/68401
|
||||
* gfortran.map: Add GFORTRAN_10 node, add _gfortran_os_error_at
|
||||
symbol.
|
||||
* libgfortran.h (os_error_at): New prototype.
|
||||
* runtime/error.c (os_error_at): New function.
|
||||
|
||||
2019-08-13 Janne Blomqvist <jb@gcc.gnu.org>
|
||||
|
||||
PR fortran/91414
|
||||
|
|
|
|||
|
|
@ -1602,3 +1602,8 @@ GFORTRAN_9.2 {
|
|||
_gfortran_mfindloc1_r10;
|
||||
_gfortran_sfindloc1_r10;
|
||||
} GFORTRAN_9;
|
||||
|
||||
GFORTRAN_10 {
|
||||
global:
|
||||
_gfortran_os_error_at;
|
||||
} GFORTRAN_9.2;
|
||||
|
|
|
|||
|
|
@ -728,6 +728,10 @@ internal_proto(gfc_xtoa);
|
|||
extern _Noreturn void os_error (const char *);
|
||||
iexport_proto(os_error);
|
||||
|
||||
extern _Noreturn void os_error_at (const char *, const char *, ...)
|
||||
__attribute__ ((format (gfc_printf, 2, 3)));
|
||||
iexport_proto(os_error_at);
|
||||
|
||||
extern void show_locus (st_parameter_common *);
|
||||
internal_proto(show_locus);
|
||||
|
||||
|
|
|
|||
|
|
@ -403,7 +403,51 @@ os_error (const char *message)
|
|||
estr_writev (iov, 5);
|
||||
exit_error (1);
|
||||
}
|
||||
iexport(os_error);
|
||||
iexport(os_error); /* TODO, DEPRECATED, ABI: Should not be exported
|
||||
anymore when bumping so version. */
|
||||
|
||||
|
||||
/* Improved version of os_error with a printf style format string and
|
||||
a locus. */
|
||||
|
||||
void
|
||||
os_error_at (const char *where, const char *message, ...)
|
||||
{
|
||||
char errmsg[STRERR_MAXSZ];
|
||||
char buffer[STRERR_MAXSZ];
|
||||
struct iovec iov[6];
|
||||
va_list ap;
|
||||
recursion_check ();
|
||||
int written;
|
||||
|
||||
iov[0].iov_base = (char*) where;
|
||||
iov[0].iov_len = strlen (where);
|
||||
|
||||
iov[1].iov_base = (char*) ": ";
|
||||
iov[1].iov_len = strlen (iov[1].iov_base);
|
||||
|
||||
va_start (ap, message);
|
||||
written = vsnprintf (buffer, STRERR_MAXSZ, message, ap);
|
||||
va_end (ap);
|
||||
iov[2].iov_base = buffer;
|
||||
if (written >= 0)
|
||||
iov[2].iov_len = written;
|
||||
else
|
||||
iov[2].iov_len = 0;
|
||||
|
||||
iov[3].iov_base = (char*) ": ";
|
||||
iov[3].iov_len = strlen (iov[3].iov_base);
|
||||
|
||||
iov[4].iov_base = gf_strerror (errno, errmsg, STRERR_MAXSZ);
|
||||
iov[4].iov_len = strlen (iov[4].iov_base);
|
||||
|
||||
iov[5].iov_base = (char*) "\n";
|
||||
iov[5].iov_len = 1;
|
||||
|
||||
estr_writev (iov, 6);
|
||||
exit_error (1);
|
||||
}
|
||||
iexport(os_error_at);
|
||||
|
||||
|
||||
/* void runtime_error()-- These are errors associated with an
|
||||
|
|
|
|||
Loading…
Reference in New Issue