gcc/testsuite/gfortran.dg/PR100094.f90

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for PR100094
   4 !
   5
   6 program foo_p
   7
   8   implicit none
   9
  10   integer, parameter :: n = 11
  11
  12   integer, pointer :: pout(:)
  13   integer,  target :: a(n)
  14   integer          :: i
  15
  16   a = [(i, i=1,n)]
  17   call foo(pout)
  18   if(.not.associated(pout)) stop 1
  19   if(.not.associated(pout, a)) stop 2
  20   if(any(pout/=a)) stop 3
  21   stop
  22
  23 contains
  24
  25   subroutine foo(that)
  26     integer, pointer, intent(out) :: that(..)
  27
  28     select rank(that)
  29     rank(1)
  30       that => a
  31     rank default
  32       stop 4
  33     end select
  34     return
  35   end subroutine foo
  36
  37 end program foo_p