gcc/testsuite/gfortran.dg/altreturn_5.f90

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