gcc/testsuite/gfortran.dg/external_procedures_3.f90

   1 ! { dg-do run }
   2 ! Tests the fix for PR32926, in which the call to fcn
   3 ! in bar would cause an ICE because it had not been referenced
   4 ! in the namespace where it was declared.
   5 !
   6 ! Contributed by Ralph Baker Kearfott <rbk@louisiana.edu>
   7 !
   8 subroutine foobar1
   9   common // chr
  10   character(8) :: chr
  11   chr = "foobar1"
  12 end subroutine
  13 subroutine foobar2
  14   common // chr
  15   character(8) :: chr
  16   chr = "foobar2"
  17 end subroutine
  18
  19 subroutine foo (fcn)
  20   external fcn
  21   call bar
  22 contains
  23   subroutine bar
  24     call fcn
  25   end subroutine bar
  26 end subroutine foo
  27
  28   external foo, foobar1, foobar2
  29   common // chr
  30   character(8) :: chr
  31   call foo (foobar1)
  32   if (chr .ne. "foobar1") call abort ()
  33   call foo (foobar2)
  34   if (chr .ne. "foobar2") call abort ()
  35 end