[Patch, fortran] PR54107 ICE on recursive interface

[Patch, fortran] PR54107 ICE on recursive interface

[Mikael Morin]

[-- Attachment #1: Type: text/plain, Size: 619 bytes --]

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?



[-- Attachment #2: pr54107_comment4_submit.CL --]
[-- Type: text/plain, Size: 405 bytes --]

2013-02-07  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  Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/54107
	* gfortran.dg/recursive_interface_2.f90: New test.

[-- Attachment #3: pr54107_comment4_submit.diff --]
[-- Type: text/plain, Size: 2341 bytes --]

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);

[-- Attachment #4: recursive_interface_2.f90 --]
[-- Type: text/x-fortran, Size: 540 bytes --]

! { 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

Re: [Patch, fortran] PR54107 ICE on recursive interface

[Paul Richard Thomas]

Mikael,

The patch itself is good for trunk - it's rather clever, in fact :-)

What's happened to the testcase?  There are still lots of commented
out lines that I presume are fixed.

Cheers

Paul

On 7 February 2013 23:28, Mikael Morin <mikael.morin@sfr.fr> wrote:
> 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?
>
>



--
The knack of flying is learning how to throw yourself at the ground and miss.
       --Hitchhikers Guide to the Galaxy

Re: [Patch, fortran] PR54107 ICE on recursive interface

[Mikael Morin]

[-- Attachment #1: Type: text/plain, Size: 374 bytes --]

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







[-- Attachment #2: r195890.diff --]
[-- Type: text/plain, Size: 4142 bytes --]

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  <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
Index: fortran/ChangeLog
===================================================================
--- fortran/ChangeLog	(révision 195889)
+++ fortran/ChangeLog	(révision 195890)
@@ -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 
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);