gcc/testsuite/gfortran.dg/internal_pack_12.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-fdump-tree-original" }
   3 !
   4 ! Test the fix for PR43243, where unnecessary calls to internal_pack/unpack
   5 ! were being produced below. These references are contiguous and so do not
   6 ! need a temporary. In addition, the final call to 'bar' required a pack/unpack
   7 ! which had been missing since r156680, at least.
   8 !
   9 ! Contributed Tobias Burnus <burnus@gcc.gnu.org>
  10 !
  11 module m
  12   type t
  13     integer, allocatable :: a(:)
  14     integer, pointer :: b(:)
  15     integer :: c(5)
  16   end type t
  17 end module m
  18
  19 subroutine foo(a,d,e,n)
  20   use m
  21   implicit none
  22   integer :: n
  23   type(t) :: a
  24   type(t), allocatable :: d(:)
  25   type(t), pointer :: e(:)
  26   call bar(   a%a) ! OK - no array temp needed
  27   call bar(   a%c) ! OK - no array temp needed
  28
  29   call bar(   a%a(1:n)) ! Missed: No pack needed
  30   call bar(   a%b(1:n)) ! OK: pack needed
  31   call bar(   a%c(1:n)) ! Missed: No pack needed
  32
  33   call bar(d(1)%a(1:n)) ! Missed: No pack needed
  34   call bar(d(1)%b(1:n)) ! OK: pack needed
  35   call bar(d(1)%c(1:n)) ! Missed: No pack needed
  36
  37   call bar(e(1)%a(1:n)) ! Missed: No pack needed
  38   call bar(e(1)%b(1:n)) ! OK: pack needed
  39   call bar(e(1)%c(1:n)) ! Missed: No pack needed
  40 end subroutine foo
  41
  42 use m
  43 implicit none
  44 integer :: i
  45 integer, target :: z(6)
  46 type(t) :: y
  47
  48 z = [(i, i=1,6)]
  49 y%b => z(::2)
  50 call bar(y%b)  ! Missed: Pack needed
  51 end
  52
  53 subroutine bar(x)
  54   integer :: x(1:*)
  55   print *, x(1:3)
  56   if (any (x(1:3) /= [1,3,5])) call abort ()
  57 end subroutine bar
  58 ! { dg-final { scan-tree-dump-times "unpack" 4 "original" } }
  59 ! { dg-final { cleanup-tree-dump "original" } }
  60 ! { dg-final { cleanup-modules "m" } }
  61