gcc/testsuite/gfortran.dg/assumed_dummy_1.f90

   1 ! { dg-do run }
   2 ! Tests the fix for PRs 19358, 19477, 21211 and 21622.
   3 !
   4 ! Note that this tests only the valid cases with explicit interfaces.
   5 !
   6 ! Contributed by Paul Thomas  <pault@gcc.gnu.org>
   7 !
   8 module global
   9 contains
  10   SUBROUTINE goo (x, i)
  11     REAL, DIMENSION(i:)     :: x
  12     integer                 :: i
  13     x (3) = 99.0
  14   END SUBROUTINE goo
  15 end module global
  16
  17 SUBROUTINE foo (x, i)
  18   REAL, DIMENSION(i:)       :: x
  19   integer                   :: i
  20   x (4) = 42.0
  21 END SUBROUTINE foo
  22
  23 program test
  24   use global
  25   real, dimension(3)        :: y = 0
  26   integer                   :: j = 2
  27
  28 interface
  29   SUBROUTINE foo (x, i)
  30     REAL, DIMENSION(i:)     :: x
  31     integer                 :: i
  32   END SUBROUTINE foo
  33 end interface
  34   call foo (y, j)
  35   call goo (y, j)
  36   call roo (y, j)
  37   if (any(y.ne.(/21.0, 99.0, 42.0/))) call abort ()
  38 contains
  39   SUBROUTINE roo (x, i)
  40     REAL, DIMENSION(i:)     :: x
  41     integer                 :: i
  42     x (2) = 21.0
  43   END SUBROUTINE roo
  44 end program test