gcc/testsuite/gfortran.dg/internal_pack_6.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fdump-tree-original" }
   3 !
   4 ! Test the fix for PR41113 and PR41117, in which unnecessary calls
   5 ! to internal_pack and internal_unpack were being generated.
   6 !
   7 ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
   8 !
   9 MODULE M1
  10  TYPE T1
  11    REAL :: data(10) = [(i, i = 1, 10)]
  12  END TYPE T1
  13 CONTAINS
  14  SUBROUTINE S1(data, i, chksum)
  15    REAL, DIMENSION(*) :: data
  16    integer :: i, j
  17    real :: subsum, chksum
  18    subsum = 0
  19    do j = 1, i
  20      subsum = subsum + data(j)
  21    end do
  22    if (abs(subsum - chksum) > 1e-6) call abort
  23  END SUBROUTINE S1
  24 END MODULE
  25
  26 SUBROUTINE S2
  27  use m1
  28  TYPE(T1) :: d
  29
  30  real :: data1(10) = [(i, i = 1, 10)]
  31  REAL :: data(-4:5,-4:5) = reshape ([(real(i), i = 1, 100)], [10,10])
  32
  33 ! PR41113
  34  CALL S1(d%data, 10, sum (d%data))
  35  CALL S1(data1, 10, sum (data1))
  36
  37 ! PR41117
  38  DO i=-4,5
  39     CALL S1(data(:,i), 10, sum (data(:,i)))
  40  ENDDO
  41
  42 ! With the fix for PR41113/7 this is the only time that _internal_pack
  43 ! was called.  The final part of the fix for PR43072 put paid to it too.
  44  DO i=-4,5
  45     CALL S1(data(-2:,i), 8, sum (data(-2:,i)))
  46  ENDDO
  47  DO i=-4,4
  48     CALL S1(data(:,i:i+1), 20, sum (reshape (data(:,i:i+1), [20])))
  49  ENDDO
  50  DO i=-4,5
  51     CALL S1(data(2,i), 1, data(2,i))
  52  ENDDO
  53 END SUBROUTINE S2
  54
  55  call s2
  56 end
  57 ! { dg-final { scan-tree-dump-times "_gfortran_internal_pack" 0 "original" } }
  58 ! { dg-final { cleanup-tree-dump "original" } }