[fortran,committed] Fix bogus recursion check

Message ID 0005c57d-fc7f-9dd1-c73a-303305a2c419@netcologne.de
State New
Headers show
Series
  • [fortran,committed] Fix bogus recursion check
Related show

Commit Message

Jonathan Wakely via Gcc-patches June 29, 2020, 9:14 p.m.
Hello world,

I just committed the attached patch as obvious and simple. It's
one line, or alternatively, 24 characters long :-)

Best regards

	Thomas

Do not generate recursion check for compiler-generated procedures.

This one-line fix removes a check for recursion for procedures
which are compiler-generated, such as finalizers or deallocation.
These need to be recursive, even if the user code should not be.

gcc/fortran/ChangeLog:

	PR fortran/95743
	* trans-decl.c (gfc_generate_function_code): Do not generate
	recursion check for compiler-generated procedures.

Patch

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index e10122e6e0c..769ab20c82d 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -6789,7 +6789,7 @@  gfc_generate_function_code (gfc_namespace * ns)
 		 || (sym->attr.entry_master
 		     && sym->ns->entries->sym->attr.recursive);
   if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION)
-      && !is_recursive && !flag_recursive)
+      && !is_recursive && !flag_recursive && !sym->attr.artificial)
     {
       char * msg;
 
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_16.f90 b/gcc/testsuite/gfortran.dg/recursive_check_16.f90
new file mode 100644
index 00000000000..d8e9d69ea7b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_check_16.f90
@@ -0,0 +1,25 @@ 
+! { dg-do  run }
+! ! { dg-options "-fcheck=recursion" }
+! PR 95743 - this used cause a runtime error.
+! Test case by Antoine Lemoine
+
+program test_recursive_call
+   implicit none
+
+   type t_tree_node
+      type(t_tree_node), dimension(:), allocatable :: child
+   end type
+
+   type t_tree
+      type(t_tree_node), allocatable :: root
+   end type
+
+   type(t_tree), allocatable :: tree
+
+   allocate(tree)
+   allocate(tree%root)
+   allocate(tree%root%child(1))
+   ! If the line below is removed, the code works fine.
+   allocate(tree%root%child(1)%child(1))
+   deallocate(tree)
+end program