Hello,
this is the last remaining patch to fix an infinite recursion when
creating the middle-end type of a function having a dummy
procedure whose interface is the function itself.
This patch is a slight variation of the comment 4 fix that was attached
to the PR. It sets the procedure's backend_decl to error_mark_node, so
that the recursion can be detected and handled in the next iteration. I
don't think the middle-end supports recursive function types, so the
middle-end types for recursive dummy procedure are actually variadic
procedure types.
regression tested on x86_64-unknown-linux-gnu. OK for trunk?
2013-02-07 Mikael Morin <[email protected]>
PR fortran/54107
* trans-types.c (gfc_get_function_type): Change a NULL backend_decl
to error_mark_node on entry. Detect recursive types. Build a variadic
procedure type if the type is recursive. Restore the initial
backend_decl.
2013-02-07 Mikael Morin <[email protected]>
PR fortran/54107
* gfortran.dg/recursive_interface_2.f90: New test.
diff --git a/trans-types.c b/trans-types.c
index 21aa75c..360c782 100644
--- a/trans-types.c
+++ b/trans-types.c
@@ -2711,19 +2711,23 @@ gfc_get_function_type (gfc_symbol * sym)
gfc_formal_arglist *f;
gfc_symbol *arg;
int alternate_return;
- bool is_varargs = true;
+ bool is_varargs = true, recursive_type = false;
/* Make sure this symbol is a function, a subroutine or the main
program. */
gcc_assert (sym->attr.flavor == FL_PROCEDURE
|| sym->attr.flavor == FL_PROGRAM);
- if (sym->backend_decl)
- {
- if (sym->attr.proc_pointer)
- return TREE_TYPE (TREE_TYPE (sym->backend_decl));
- return TREE_TYPE (sym->backend_decl);
- }
+ /* To avoid recursing infinitely on recrusive types, we use error_mark_node
+ so that they can be detected here and handled further down. */
+ if (sym->backend_decl == NULL)
+ sym->backend_decl = error_mark_node;
+ else if (sym->backend_decl == error_mark_node)
+ recursive_type = true;
+ else if (sym->attr.proc_pointer)
+ return TREE_TYPE (TREE_TYPE (sym->backend_decl));
+ else
+ return TREE_TYPE (sym->backend_decl);
alternate_return = 0;
typelist = NULL;
@@ -2775,6 +2779,13 @@ gfc_get_function_type (gfc_symbol * sym)
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 = build_pointer_type (type);
}
@@ -2828,6 +2839,11 @@ gfc_get_function_type (gfc_symbol * sym)
|| sym->attr.if_source != IFSRC_UNKNOWN)
is_varargs = false;
+arg_type_list_done:
+
+ if (!recursive_type && sym->backend_decl == error_mark_node)
+ sym->backend_decl = NULL_TREE;
+
if (alternate_return)
type = integer_type_node;
else if (!sym->attr.function || gfc_return_by_reference (sym))
@@ -2865,7 +2881,7 @@ gfc_get_function_type (gfc_symbol * sym)
else
type = gfc_sym_type (sym);
- if (is_varargs)
+ if (is_varargs || recursive_type)
type = build_varargs_function_type_vec (type, typelist);
else
type = build_function_type_vec (type, typelist);
! { dg-do compile }
!
! PR fortran/54107
! Recursive interfaces used to lead to an infinite recursion during
! resolution.
module m
contains
! subroutine foo (arg)
! procedure(foo) :: arg
! end subroutine
subroutine bar()
end subroutine bar
function foo2 (arg) result(r)
! procedure(foo2) :: arg
procedure(bar) :: arg
procedure(foo2), pointer :: r
end function
! subroutine bar (arg)
! procedure(baz) :: arg
! end subroutine
! subroutine baz (arg)
! procedure(bar) :: arg
! end subroutine
end module m
