gcc/testsuite/gfortran.dg/recursive_check_7.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fcheck=recursion" }
   3 ! { dg-shouldfail "Recursion check" }
   4 !
   5 ! PR fortran/32626
   6 ! Recursion run-time check
   7 !
   8
   9 subroutine NormalFunc()
  10 end subroutine NormalFunc
  11
  12 recursive subroutine valid(x)
  13   logical :: x
  14   if(x) call sndValid()
  15   print *, 'OK'
  16 end subroutine valid
  17
  18 subroutine sndValid()
  19   call valid(.false.)
  20 end subroutine sndValid
  21
  22 subroutine invalid(x)
  23   logical :: x
  24   if(x) call sndInvalid()
  25   print *, 'BUG'
  26   call abort()
  27 end subroutine invalid
  28
  29 subroutine sndInvalid()
  30   call invalid(.false.)
  31 end subroutine sndInvalid
  32
  33 call valid(.true.)
  34 call valid(.true.)
  35 call NormalFunc()
  36 call NormalFunc()
  37 call invalid(.true.)
  38 end
  39
  40 ! { dg-output "Fortran runtime error: Recursive call to nonrecursive procedure 'invalid'" }