re PR fortran/60191 (test case gfortran.dg/dynamic_dispatch_1/3.f03 fail on ARMv7)

2014-04-04  Bernd Edlinger  <bernd.edlinger@hotmail.de>

        PR fortran/60191
        * fortran/trans-types.c (gfc_get_function_type): In case of recursion
        build a variadic function type with empty argument list instead of a
        stdarg-like function type with incomplete argument list.

From-SVN: r209091
This commit is contained in:
Bernd Edlinger 2014-04-04 13:54:16 +00:00
parent fc02bcca01
commit 57ef133bab
2 changed files with 16 additions and 19 deletions

View File

@ -1,3 +1,10 @@
2014-04-04 Bernd Edlinger <bernd.edlinger@hotmail.de>
PR fortran/60191
* fortran/trans-types.c (gfc_get_function_type): In case of recursion
build a variadic function type with empty argument list instead of a
stdarg-like function type with incomplete argument list.
2014-04-04 Jeff Law <law@redhat.com> 2014-04-04 Jeff Law <law@redhat.com>
PR target/60657 PR target/60657

View File

@ -2714,11 +2714,11 @@ tree
gfc_get_function_type (gfc_symbol * sym) gfc_get_function_type (gfc_symbol * sym)
{ {
tree type; tree type;
vec<tree, va_gc> *typelist; vec<tree, va_gc> *typelist = NULL;
gfc_formal_arglist *f; gfc_formal_arglist *f;
gfc_symbol *arg; gfc_symbol *arg;
int alternate_return; int alternate_return = 0;
bool is_varargs = true, recursive_type = false; bool is_varargs = true;
/* Make sure this symbol is a function, a subroutine or the main /* Make sure this symbol is a function, a subroutine or the main
program. */ program. */
@ -2730,15 +2730,12 @@ gfc_get_function_type (gfc_symbol * sym)
if (sym->backend_decl == NULL) if (sym->backend_decl == NULL)
sym->backend_decl = error_mark_node; sym->backend_decl = error_mark_node;
else if (sym->backend_decl == error_mark_node) else if (sym->backend_decl == error_mark_node)
recursive_type = true; goto arg_type_list_done;
else if (sym->attr.proc_pointer) else if (sym->attr.proc_pointer)
return TREE_TYPE (TREE_TYPE (sym->backend_decl)); return TREE_TYPE (TREE_TYPE (sym->backend_decl));
else else
return TREE_TYPE (sym->backend_decl); return TREE_TYPE (sym->backend_decl);
alternate_return = 0;
typelist = NULL;
if (sym->attr.entry_master) if (sym->attr.entry_master)
/* Additional parameter for selecting an entry point. */ /* Additional parameter for selecting an entry point. */
vec_safe_push (typelist, gfc_array_index_type); vec_safe_push (typelist, gfc_array_index_type);
@ -2786,13 +2783,6 @@ gfc_get_function_type (gfc_symbol * sym)
if (arg->attr.flavor == FL_PROCEDURE) if (arg->attr.flavor == FL_PROCEDURE)
{ {
/* We don't know in the general case which argument causes
recursion. But we know that it is a procedure. So we give up
creating the procedure argument type list at the first
procedure argument. */
if (recursive_type)
goto arg_type_list_done;
type = gfc_get_function_type (arg); type = gfc_get_function_type (arg);
type = build_pointer_type (type); type = build_pointer_type (type);
} }
@ -2846,11 +2836,11 @@ gfc_get_function_type (gfc_symbol * sym)
|| sym->attr.if_source != IFSRC_UNKNOWN) || sym->attr.if_source != IFSRC_UNKNOWN)
is_varargs = false; is_varargs = false;
arg_type_list_done: if (sym->backend_decl == error_mark_node)
if (!recursive_type && sym->backend_decl == error_mark_node)
sym->backend_decl = NULL_TREE; sym->backend_decl = NULL_TREE;
arg_type_list_done:
if (alternate_return) if (alternate_return)
type = integer_type_node; type = integer_type_node;
else if (!sym->attr.function || gfc_return_by_reference (sym)) else if (!sym->attr.function || gfc_return_by_reference (sym))
@ -2888,7 +2878,7 @@ arg_type_list_done:
else else
type = gfc_sym_type (sym); type = gfc_sym_type (sym);
if (is_varargs || recursive_type) if (is_varargs)
type = build_varargs_function_type_vec (type, typelist); type = build_varargs_function_type_vec (type, typelist);
else else
type = build_function_type_vec (type, typelist); type = build_function_type_vec (type, typelist);