gcc/testsuite/gfortran.dg/namelist_20.f90

   1 !{ dg-do run { target fd_truncate } }
   2 ! Tests namelist io for an explicit shape array with negative bounds
   3 ! provided by Paul Thomas - pault@gcc.gnu.org
   4
   5 program namelist_20
   6   integer, dimension (-4:-2) :: x
   7   integer                    :: i, ier
   8   namelist /a/ x
   9
  10   open (10, status = "scratch")
  11   write (10, '(A)') "&a x(-5)=0 /"            !-ve index below lbound
  12   write (10, '(A)') "&a x(-1)=0 /"            !-ve index above ubound
  13   write (10, '(A)') "&a x(1:2)=0 /"           !+ve indices
  14   write (10, '(A)') "&a x(-4:-2)= -4,-3,-2 /" !correct
  15   write (10, '(A)') " "
  16   rewind (10)
  17
  18   ier=0
  19   read(10, a, iostat=ier)
  20   if (ier == 0) call abort ()
  21   ier=0
  22   read(10, a, iostat=ier)
  23   if (ier == 0) call abort ()
  24   ier=0
  25   read(10, a, iostat=ier)
  26   if (ier == 0) call abort ()
  27
  28   ier=0
  29   read(10, a, iostat=ier)
  30   if (ier /= 0) call abort ()
  31   do i = -4,-2
  32     if (x(i) /= i) call abort ()
  33   end do
  34
  35 end program namelist_20