gcc/testsuite/gfortran.dg/parent_result_ref_3.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 ! Check that parent alternate entry results can be referenced.
   5 !
   6 function f()
   7   integer :: f, g
   8   f = 42
   9   call sub1 ()
  10   if (f.eq.1) f = 2
  11   return
  12 entry g()
  13   g = 99
  14   call sub2 ()
  15   if (g.eq.77) g = 33
  16 contains
  17   subroutine sub1
  18     if (f.eq.42) f = 1
  19   end subroutine sub1
  20   subroutine sub2
  21     if (g.eq.99) g = g - 22
  22   end subroutine sub2
  23 end function f
  24
  25   integer, external :: f, g
  26   if (f ().ne.2) STOP 1
  27   if (g ().ne.33) STOP 2
  28 end