gcc/testsuite/gfortran.dg/array_assignment_1.F90

   1 ! { dg-do run }
   2 ! { dg-options "-ffree-line-length-none" }
   3 ! Test that different array assignments work even when interleaving,
   4 ! reversing etc.  Make sure the results from assignment with constants
   5 ! as array triples and runtime array triples (where we always create
   6 ! a temporary) match.
   7 #define TST(b,c,d,e,f,g,r) a=init; a(b:c:d) = a(e:f:g); \
   8        write(unit=line ,fmt="(9I1)") a;\
   9        if (line /= r) STOP 1; \
  10        call mytst(b,c,d,e,f,g,r);
  11
  12 program main
  13   implicit none
  14   integer :: i
  15   integer, parameter :: n=9
  16   integer,  dimension(n) :: a
  17   character(len=n) :: line
  18   integer, dimension(n), parameter :: init = (/(i,i=1,n)/)
  19   TST(2,n,2,1,n-1,2,'113355779')
  20   TST(3,9,3,2,6,2,'122454786');
  21   TST(1,8,2,3,9,2,'325476989');
  22   TST(1,6,1,4,9,1,'456789789');
  23   TST(9,5,-1,1,5,1,'123454321');
  24   TST(9,5,-2,1,5,2,'123456381');
  25   TST(5,9,2,5,1,-2,'123456381');
  26   TST(1,6,1,2,7,1,'234567789');
  27   TST(2,7,1,1,6,1,'112345689');
  28 end program main
  29
  30 subroutine mytst(b,c,d,e,f,g,r)
  31   integer,intent(in) :: b,c,d,e,f,g
  32   character(len=9), intent(in) :: r
  33   character(len=9) :: line
  34   integer, dimension(9) :: a
  35   a = (/(i,i=1,9)/)
  36   a(b:c:d) = a(e:f:g)
  37   write (unit=line,fmt='(9I1)') a
  38   if (line /= r) STOP 2
  39 end subroutine mytst