gcc/testsuite/gfortran.dg/parent_result_ref_1.f90

   1 ! { dg-do run }
   2 ! Tests the fix for PR19546 in which an ICE would result from
   3 ! setting the parent result in a contained procedure.
   4 ! From the testcase of Francois-Xavier Coudert/Tobias Schlueter
   5 !
   6 function f()
   7   integer :: f
   8   f = 42
   9   call sub ()
  10   if (f.eq.1) f = f + 1
  11 contains
  12   subroutine sub
  13     if (f.eq.42) f = f - 41
  14   end subroutine sub
  15 end function f
  16
  17   integer, external :: f
  18   if (f ().ne.2) call abort ()
  19 end