Le 08/02/2013 14:06, Paul Richard Thomas a Ă©crit : > What's happened to the testcase? There are still lots of commented > out lines that I presume are fixed. > Well, I was playing with the testcase just before I sent the patch for review đŸ˜–. Attached is what I have committed - testcase fixed, as well as a typo (recrusive).
Thanks for the review. Mikael
Index: testsuite/gfortran.dg/recursive_interface_2.f90 =================================================================== --- testsuite/gfortran.dg/recursive_interface_2.f90 (révision 0) +++ testsuite/gfortran.dg/recursive_interface_2.f90 (révision 195890) @@ -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 Index: testsuite/ChangeLog =================================================================== --- testsuite/ChangeLog (révision 195889) +++ testsuite/ChangeLog (révision 195890) @@ -1,3 +1,8 @@ +2013-02-08 Mikael Morin <mik...@gcc.gnu.org> + + PR fortran/54107 + * gfortran.dg/recursive_interface_2.f90: New test. + 2013-02-08 Jakub Jelinek <ja...@redhat.com> PR tree-optimization/56250 Index: fortran/ChangeLog =================================================================== --- fortran/ChangeLog (révision 195889) +++ fortran/ChangeLog (révision 195890) @@ -1,3 +1,11 @@ +2013-02-08 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 Tobias Burnus <bur...@net-b.de> PR fortran/54339 Index: fortran/trans-types.c =================================================================== --- fortran/trans-types.c (révision 195889) +++ fortran/trans-types.c (révision 195890) @@ -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);