gcc/testsuite/gfortran.dg/array_1.f90

   1 ! { dg-do run }
   2 ! PR 15553 : the array used to be filled with garbage
   3 ! this problem disappeared between 2004-05-20 and 2004-09-15
   4 program arrpack
   5   implicit none
   6
   7   double precision x(10,10)
   8   integer i, j
   9
  10   x = -1
  11   do i=1,6
  12      do j=1,5
  13         x(i,j) = i+j*10
  14      end do
  15   end do
  16   call pack (x, 6, 5)
  17
  18   if (any(reshape(x(1:10,1:3), (/ 30 /)) &
  19           /= (/ 11, 12, 13, 14, 15, 16,  &
  20                 21, 22, 23, 24, 25, 26,  &
  21                 31, 32, 33, 34, 35, 36,  &
  22                 41, 42, 43, 44, 45, 46,  &
  23                 51, 52, 53, 54, 55, 56 /))) call abort ()
  24
  25 contains
  26
  27   subroutine pack (arr, ni, nj)
  28     integer, intent(in) :: ni, nj
  29     double precision, intent(inout) :: arr(:,:)
  30     double precision :: tmp(ni,nj)
  31     tmp(:,:) = arr(1:ni, 1:nj)
  32     call copy (arr, tmp, ni, nj)
  33   end subroutine pack
  34
  35   subroutine copy (dst, src, ni, nj)
  36     integer, intent(in) :: ni, nj
  37     double precision, intent(out) :: dst(ni, nj)
  38     double precision, intent(in)  :: src(ni, nj)
  39     dst = src
  40   end subroutine copy
  41
  42 end program arrpack