gcc/testsuite/gfortran.dg/assumed_shape_ranks_2.f90

   1 ! { dg-do run }
   2 ! Tests the fix for the regression PR26716.
   3 ! Test contributed by Martin Reinecke  <martin@mpa-garching.mpg.de>
   4 !
   5 module mod1
   6   implicit none
   7
   8   interface foo
   9      module procedure foo1, foo2
  10   end interface
  11
  12 contains
  13
  14   subroutine foo1(bar, i)
  15     real bar
  16     integer i
  17     i = 1
  18    end subroutine
  19
  20   subroutine foo2(bar, i)
  21     real bar(3)
  22     integer i
  23     i = 2
  24   end subroutine
  25
  26 end module mod1
  27
  28   use mod1
  29   implicit none
  30
  31   real bar(3)
  32   integer i
  33
  34   i = 0
  35   call foo (1e0, i)
  36   if (i .ne. 1) call abort ()
  37
  38   i = 0
  39   call foo (bar(1), i)
  40   if (i .ne. 1) call abort ()
  41
  42   i = 0
  43   call foo (bar, i)
  44   if (i .ne. 2) call abort ()
  45 end