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 <mik...@gcc.gnu.org> 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 <mik...@gcc.gnu.org> 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