===================================================================
@@ -0,0 +1,22 @@
+! { dg-do compile }
+!
+! PR fortran/54107
+! Recursive interfaces used to lead to an infinite recursion during
+! translation.
+
+module m
+ contains
+ subroutine foo (arg)
+ procedure(foo) :: arg
+ end subroutine
+ function foo2 (arg) result(r)
+ procedure(foo2) :: 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
===================================================================
@@ -1,3 +1,8 @@
+2013-02-08 Mikael Morin <mikael@gcc.gnu.org>
+
+ PR fortran/54107
+ * gfortran.dg/recursive_interface_2.f90: New test.
+
2013-02-08 Jakub Jelinek <jakub@redhat.com>
PR tree-optimization/56250
===================================================================
@@ -1,3 +1,11 @@
+2013-02-08 Mikael Morin <mikael@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 Tobias Burnus <burnus@net-b.de>
PR fortran/54339
===================================================================
@@ -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 recursive 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);