gcc/testsuite/gfortran.dg/altreturn_5.f90

   1 ! { dg-do run }
   2 ! Tests the fix for PR31483, in which dummy argument procedures
   3 ! produced an ICE if they had an alternate return.
   4 !
   5 ! Contributed by Mathias Fröhlich <M.Froehlich@science-computing.de>
   6
   7       SUBROUTINE R (i, *, *)
   8       INTEGER i
   9       RETURN i
  10       END
  11
  12       SUBROUTINE PHLOAD (READER, i, res)\r
  13       IMPLICIT NONE\r
  14       EXTERNAL         READER
  15       integer i
  16       character(3) res\r
  17       CALL READER (i, *1, *2)\r
  18  1    res = "one"
  19       return\r
  20  2    res = "two"
  21       return\r
  22       END
  23
  24       EXTERNAL R
  25       character(3) res\r
  26       call PHLOAD (R, 1, res)
  27       if (res .ne. "one") call abort ()
  28       CALL PHLOAD (R, 2, res)
  29       if (res .ne. "two") call abort ()
  30       END\r
  31 \r