diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 17 | ||||
| -rw-r--r-- | gcc/fortran/trans-decl.c | 12 | ||||
| -rw-r--r-- | gcc/fortran/trans.c | 68 | ||||
| -rw-r--r-- | gcc/fortran/trans.h | 2 |
4 files changed, 64 insertions, 35 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index bab69f3..a3b9e6b 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -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 diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 2a9b852..3c6ab60 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -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")), diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 8451147..583f6e3 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -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); diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index a3726e8..8082b41 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -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; |