gcc/testsuite/gfortran.dg/internal_pack_8.f90

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for PR43111, in which necessary calls to
   4 ! internal PACK/UNPACK were not being generated because
   5 ! of an over agressive fix to PR41113/7.
   6 !
   7 ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
   8 !
   9 SUBROUTINE S2(I)
  10  INTEGER :: I(4)
  11  !write(6,*) I
  12  IF (ANY(I.NE.(/3,5,7,9/))) CALL ABORT()
  13 END SUBROUTINE S2
  14
  15 MODULE M1
  16  TYPE T1
  17   INTEGER, POINTER, DIMENSION(:) :: data
  18  END TYPE T1
  19 CONTAINS
  20  SUBROUTINE S1()
  21    TYPE(T1) :: d
  22    INTEGER, TARGET, DIMENSION(10) :: scratch=(/(i,i=1,10)/)
  23    INTEGER :: i=2
  24    d%data=>scratch(1:9:2)
  25 !   write(6,*) d%data(i:)
  26    CALL S2(d%data(i:))
  27  END SUBROUTINE S1
  28 END MODULE M1
  29
  30 USE M1
  31 CALL S1
  32 END