gcc/testsuite/gfortran.dg/associate_24.f90

   1 ! { dg-do run }
   2 !
   3 ! From posting by Spectrum to clf on thread entitled "Bounds for array pointer dummy argument".
   4 !
   5 PROGRAM X
   6     implicit none
   7     TYPE T
   8         INTEGER :: I
   9     END TYPE T
  10     TYPE(T), TARGET :: T1( 0:3 )
  11
  12     associate( P => T1 % I )
  13         call check (lbound (P, 1), ubound (P, 1) ,1 , 4)
  14     endassociate
  15
  16     associate( P2 => T1(:) % I )
  17         call check (lbound (P2, 1), ubound (P2, 1) ,1 , 4)
  18     endassociate
  19
  20     associate( Q => T1 )
  21         call check (lbound (Q, 1), ubound (Q, 1) ,0 , 3)
  22     endassociate
  23
  24     associate( Q2 => T1(:) )
  25         call check (lbound (Q2, 1), ubound (Q2, 1) ,1 , 4)
  26     endassociate
  27 contains
  28     subroutine check (lbnd, ubnd, lower, upper)
  29       integer :: lbnd, ubnd, lower, upper
  30       if (lbnd .ne. lower) STOP 1
  31       if (ubnd .ne. upper) STOP 2
  32     end subroutine
  33 END PROGRAM X