From 95cdcf701dad826f225d6413b59650f181954399 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Mon, 29 Jun 2020 23:11:06 +0200 Subject: [PATCH] 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. --- gcc/fortran/trans-decl.c | 2 +- .../gfortran.dg/recursive_check_16.f90 | 25 +++++++++++++++++++ 2 files changed, 26 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/recursive_check_16.f90 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 -- 2.30.2