From: Thomas Koenig Date: Sun, 3 Mar 2019 09:20:09 +0000 (+0000) Subject: re PR fortran/87689 (PowerPC64 ELFv2 function parameter passing violation) X-Git-Tag: releases/gcc-7.5.0~563 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=e5ec6ea9273b6141bbac718aeb4f4549bb8074b6;p=thirdparty%2Fgcc.git re PR fortran/87689 (PowerPC64 ELFv2 function parameter passing violation) 2019-03-03 Thomas Koenig PR fortran/87689 Backport from trunk * 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-03-03 Thomas Koenig PR fortran/87689 Backport from trunk * 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. * gfortran.dg/altreturn_9_0.f90: New file. * gfortran.dg/altreturn_9_1.f90: New file. From-SVN: r269350 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0aef9299f7c7..b30685de60bc 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,18 @@ +2019-03-03 Thomas Koenig + + PR fortran/87689 + Backport from trunk + * 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-23 Paul Thomas Backport from trunk diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index c43f8e46dc51..f524363694c2 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1936,7 +1936,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; @@ -2109,7 +2109,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 8b42bbccd455..1bcc43c5546d 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -3799,7 +3799,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; @@ -3817,7 +3818,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; @@ -6238,7 +6239,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 9a96ae7b69d2..6f8bcfdaaca1 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -2897,9 +2897,57 @@ 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) + { + (*f) = gfc_get_formal_arglist (); + if (a->expr) + { + 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; + } + else /* If a->expr is NULL, this is an alternate rerturn. */ + (*f)->sym = NULL; + + 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; @@ -2957,6 +3005,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 6dba78e36715..3df9d540c151 100644 --- a/gcc/fortran/trans-types.h +++ b/gcc/fortran/trans-types.h @@ -87,7 +87,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 4fcc389a53b8..f3e5b9487431 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -578,7 +578,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 42803d36e1e7..1ea2c1fe2191 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,15 @@ +2019-03-03 Thomas Koenig + + PR fortran/87689 + Backport from trunk + * 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. + * gfortran.dg/altreturn_9_0.f90: New file. + * gfortran.dg/altreturn_9_1.f90: New file. + 2019-02-23 Paul Thomas Backport from trunk diff --git a/gcc/testsuite/gfortran.dg/altreturn_9_0.f90 b/gcc/testsuite/gfortran.dg/altreturn_9_0.f90 new file mode 100644 index 000000000000..58715c7db403 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/altreturn_9_0.f90 @@ -0,0 +1,10 @@ +! { dg-do run } +! { dg-options -std=gnu } +! { dg-additional-sources altreturn_9_1.f90 } +! PR 89496 - wrong type for alternate return was generated + +program main + call sub(10, *10, 20) + stop 1 +10 continue +end program main diff --git a/gcc/testsuite/gfortran.dg/altreturn_9_1.f90 b/gcc/testsuite/gfortran.dg/altreturn_9_1.f90 new file mode 100644 index 000000000000..9549869a6bee --- /dev/null +++ b/gcc/testsuite/gfortran.dg/altreturn_9_1.f90 @@ -0,0 +1,7 @@ +! { dg-do compile } +! { dg-options "-std=gnu" } +! See altreturn_9_0.f90 +subroutine sub(i, *, j) + if (i == 10 .and. j == 20) return 1 + return +end subroutine sub diff --git a/gcc/testsuite/gfortran.dg/lto/20091028-1_0.f90 b/gcc/testsuite/gfortran.dg/lto/20091028-1_0.f90 index 57c1b1f60287..f33f6c8b9467 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" } +! { dg-extra-ld-options "-r -nostdlib -finline-functions -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 57c1b1f60287..f33f6c8b9467 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" } +! { dg-extra-ld-options "-r -nostdlib -finline-functions -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 000000000000..5beee9391c64 --- /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 000000000000..f293a0054bd9 --- /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