From: Thomas Koenig Date: Mon, 18 Feb 2019 18:28:58 +0000 (+0000) Subject: re PR fortran/87689 (PowerPC64 ELFv2 function parameter passing violation) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=378f53c75232416c9171bcfb42a551371321bffe;p=gcc.git re PR fortran/87689 (PowerPC64 ELFv2 function parameter passing violation) 2019-02-18 Thomas Koenig PR fortran/87689 * trans-decl.c (gfc_get_extern_function_decl): Add argument actual_args and pass it through to gfc_get_function_type. * trans-expr.c (conv_function_val): Add argument actual_args and pass it on to gfc_get_extern_function_decl. (conv_procedure_call): Pass actual arguments to conv_function_val. * trans-types.c (get_formal_from_actual_arglist): New function. (gfc_get_function_type): Add argument actual_args. Generate formal args from actual args if necessary. * trans-types.h (gfc_get_function_type): Add optional argument. * trans.h (gfc_get_extern_function_decl): Add optional argument. 2019-02-18 Thomas Koenig PR fortran/87689 * gfortran.dg/lto/20091028-1_0.f90: Add -Wno-lto-type-mismatch to options. * gfortran.dg/lto/20091028-2_0.f90: Likewise. * gfortran.dg/lto/pr87689_0.f: New file. * gfortran.dg/lto/pr87689_1.f: New file. From-SVN: r268992 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a03cfd2a70b..43eda8c56d7 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,17 @@ +2019-02-18 Thomas Koenig + + PR fortran/87689 + * trans-decl.c (gfc_get_extern_function_decl): Add argument + actual_args and pass it through to gfc_get_function_type. + * trans-expr.c (conv_function_val): Add argument actual_args + and pass it on to gfc_get_extern_function_decl. + (conv_procedure_call): Pass actual arguments to conv_function_val. + * trans-types.c (get_formal_from_actual_arglist): New function. + (gfc_get_function_type): Add argument actual_args. Generate + formal args from actual args if necessary. + * trans-types.h (gfc_get_function_type): Add optional argument. + * trans.h (gfc_get_extern_function_decl): Add optional argument. + 2019-02-18 Martin Liska * decl.c (gfc_match_gcc_builtin): Add support for filtering diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 9a8f2d36784..3604cfcf5cb 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1962,7 +1962,7 @@ get_proc_pointer_decl (gfc_symbol *sym) /* Get a basic decl for an external function. */ tree -gfc_get_extern_function_decl (gfc_symbol * sym) +gfc_get_extern_function_decl (gfc_symbol * sym, gfc_actual_arglist *actual_args) { tree type; tree fndecl; @@ -2135,7 +2135,7 @@ module_sym: mangled_name = gfc_sym_mangled_function_id (sym); } - type = gfc_get_function_type (sym); + type = gfc_get_function_type (sym, actual_args); fndecl = build_decl (input_location, FUNCTION_DECL, name, type); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index e7c75913bfe..a75f8a7c250 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -3895,7 +3895,8 @@ conv_base_obj_fcn_val (gfc_se * se, tree base_object, gfc_expr * expr) static void -conv_function_val (gfc_se * se, gfc_symbol * sym, gfc_expr * expr) +conv_function_val (gfc_se * se, gfc_symbol * sym, gfc_expr * expr, + gfc_actual_arglist *actual_args) { tree tmp; @@ -3913,7 +3914,7 @@ conv_function_val (gfc_se * se, gfc_symbol * sym, gfc_expr * expr) else { if (!sym->backend_decl) - sym->backend_decl = gfc_get_extern_function_decl (sym); + sym->backend_decl = gfc_get_extern_function_decl (sym, actual_args); TREE_USED (sym->backend_decl) = 1; @@ -6580,7 +6581,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, /* Generate the actual call. */ if (base_object == NULL_TREE) - conv_function_val (se, sym, expr); + conv_function_val (se, sym, expr, args); else conv_base_obj_fcn_val (se, base_object, expr); diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 1302d2ac70a..2115db23f2c 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -2970,9 +2970,54 @@ create_fn_spec (gfc_symbol *sym, tree fntype) return build_type_attribute_variant (fntype, tmp); } +/* Helper function - if we do not find an interface for a procedure, + construct it from the actual arglist. Luckily, this can only + happen for call by reference, so the information we actually need + to provide (and which would be impossible to guess from the call + itself) is not actually needed. */ + +static void +get_formal_from_actual_arglist (gfc_symbol *sym, gfc_actual_arglist *actual_args) +{ + gfc_actual_arglist *a; + gfc_formal_arglist **f; + gfc_symbol *s; + char name[GFC_MAX_SYMBOL_LEN + 1]; + static int var_num; + + f = &sym->formal; + for (a = actual_args; a != NULL; a = a->next) + { + if (a->expr) + { + (*f) = gfc_get_formal_arglist (); + snprintf (name, GFC_MAX_SYMBOL_LEN, "_formal_%d", var_num ++); + gfc_get_symbol (name, NULL, &s); + if (a->expr->ts.type == BT_PROCEDURE) + { + s->attr.flavor = FL_PROCEDURE; + } + else + { + s->ts = a->expr->ts; + s->attr.flavor = FL_VARIABLE; + if (a->expr->rank > 0) + { + s->attr.dimension = 1; + s->as = gfc_get_array_spec (); + s->as->type = AS_ASSUMED_SIZE; + } + } + s->attr.dummy = 1; + s->attr.intent = INTENT_UNKNOWN; + (*f)->sym = s; + } + f = &((*f)->next); + } +} tree -gfc_get_function_type (gfc_symbol * sym) +gfc_get_function_type (gfc_symbol * sym, gfc_actual_arglist *actual_args) { tree type; vec *typelist = NULL; @@ -3030,6 +3075,10 @@ gfc_get_function_type (gfc_symbol * sym) vec_safe_push (typelist, build_pointer_type(gfc_charlen_type_node)); } } + if (sym->backend_decl == error_mark_node && actual_args != NULL + && sym->formal == NULL && (sym->attr.proc == PROC_EXTERNAL + || sym->attr.proc == PROC_UNKNOWN)) + get_formal_from_actual_arglist (sym, actual_args); /* Build the argument types for the function. */ for (f = gfc_sym_get_dummy_args (sym); f; f = f->next) diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h index 2952d111c66..7d591bac63a 100644 --- a/gcc/fortran/trans-types.h +++ b/gcc/fortran/trans-types.h @@ -88,7 +88,7 @@ tree gfc_sym_type (gfc_symbol *); tree gfc_typenode_for_spec (gfc_typespec *, int c = 0); int gfc_copy_dt_decls_ifequal (gfc_symbol *, gfc_symbol *, bool); -tree gfc_get_function_type (gfc_symbol *); +tree gfc_get_function_type (gfc_symbol *, gfc_actual_arglist *args = NULL); tree gfc_type_for_size (unsigned, int); tree gfc_type_for_mode (machine_mode, int); diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 805ed76318f..7d46684e2a4 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -580,7 +580,8 @@ void gfc_merge_block_scope (stmtblock_t * block); tree gfc_get_label_decl (gfc_st_label *); /* Return the decl for an external function. */ -tree gfc_get_extern_function_decl (gfc_symbol *); +tree gfc_get_extern_function_decl (gfc_symbol *, + gfc_actual_arglist *args = NULL); /* Return the decl for a function. */ tree gfc_get_function_decl (gfc_symbol *); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 38de7998e3c..04f60aa0a89 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,12 @@ +2019-02-18 Thomas Koenig + + PR fortran/87689 + * gfortran.dg/lto/20091028-1_0.f90: Add -Wno-lto-type-mismatch to + options. + * gfortran.dg/lto/20091028-2_0.f90: Likewise. + * gfortran.dg/lto/pr87689_0.f: New file. + * gfortran.dg/lto/pr87689_1.f: New file. + 2019-02-18 Wilco Dijkstra * g++.dg/wrappers/pr88680.C: Add -fno-short-enums. diff --git a/gcc/testsuite/gfortran.dg/lto/20091028-1_0.f90 b/gcc/testsuite/gfortran.dg/lto/20091028-1_0.f90 index 3b32432f81d..b83cf6d196c 100644 --- a/gcc/testsuite/gfortran.dg/lto/20091028-1_0.f90 +++ b/gcc/testsuite/gfortran.dg/lto/20091028-1_0.f90 @@ -1,5 +1,5 @@ ! { dg-lto-do link } -! { dg-extra-ld-options "-r -nostdlib -finline-functions -flinker-output=nolto-rel" } +! { dg-extra-ld-options "-r -nostdlib -finline-functions -flinker-output=nolto-rel -Wno-lto-type-mismatch" } SUBROUTINE int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, & DataHandle, Element, VarName, Data, code ) diff --git a/gcc/testsuite/gfortran.dg/lto/20091028-2_0.f90 b/gcc/testsuite/gfortran.dg/lto/20091028-2_0.f90 index 3b32432f81d..b83cf6d196c 100644 --- a/gcc/testsuite/gfortran.dg/lto/20091028-2_0.f90 +++ b/gcc/testsuite/gfortran.dg/lto/20091028-2_0.f90 @@ -1,5 +1,5 @@ ! { dg-lto-do link } -! { dg-extra-ld-options "-r -nostdlib -finline-functions -flinker-output=nolto-rel" } +! { dg-extra-ld-options "-r -nostdlib -finline-functions -flinker-output=nolto-rel -Wno-lto-type-mismatch" } SUBROUTINE int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, & DataHandle, Element, VarName, Data, code ) diff --git a/gcc/testsuite/gfortran.dg/lto/pr87689_0.f b/gcc/testsuite/gfortran.dg/lto/pr87689_0.f new file mode 100644 index 00000000000..5beee9391c6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/lto/pr87689_0.f @@ -0,0 +1,13 @@ +! { dg-lto-run } +! PR 87689 - this used to fail for POWER, plus it used to +! give warnings about mismatches with LTO. +! Original test case by Judicaël Grasset. + program main + implicit none + character :: c + character(len=20) :: res, doesntwork_p8 + external doesntwork_p8 + c = 'o' + res = doesntwork_p8(c,1,2,3,4,5,6) + if (res /= 'foo') stop 3 + end program main diff --git a/gcc/testsuite/gfortran.dg/lto/pr87689_1.f b/gcc/testsuite/gfortran.dg/lto/pr87689_1.f new file mode 100644 index 00000000000..f293a0054bd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/lto/pr87689_1.f @@ -0,0 +1,11 @@ + function doesntwork_p8(c,a1,a2,a3,a4,a5,a6) + implicit none + character(len=20) :: doesntwork_p8 + character :: c + integer :: a1,a2,a3,a4,a5,a6 + if (a1 /= 1 .or. a2 /= 2 .or. a3 /= 3 .or. a4 /= 4 .or. a5 /= 5 + & .or. a6 /= 6) stop 1 + if (c /= 'o ') stop 2 + doesntwork_p8 = 'foo' + return + end