gcc/testsuite/gfortran.dg/contiguous_3.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-fdump-tree-original" }
   3 !
   4 ! PR fortran/40632
   5 !
   6 ! CONTIGUOUS compile-time tests: Check that contigous
   7 ! works properly.
   8
   9 subroutine test1(a,b)
  10   integer, pointer, contiguous :: test1_a(:)
  11   call foo(test1_a)
  12   call foo(test1_a(::1))
  13   call foo(test1_a(::2))
  14 contains
  15   subroutine foo(b)
  16     integer :: b(*)
  17   end subroutine foo
  18 end subroutine test1
  19
  20 ! For the first two no pack is done; for the third one, an array descriptor
  21 ! (cf. below test3) is created for packing.
  22 !
  23 ! { dg-final { scan-tree-dump-times "_internal_pack.*test1_a" 0 "original" } }
  24 ! { dg-final { scan-tree-dump-times "_internal_unpack.*test1_a" 0 "original" } }
  25
  26
  27 subroutine t2(a1,b1,c2,d2)
  28   integer, pointer, contiguous :: a1(:), b1(:)
  29   integer, pointer :: c2(:), d2(:)
  30   a1 = b1
  31   c2 = d2
  32 end subroutine t2
  33
  34 ! { dg-final { scan-tree-dump-times "= a1->dim.0..stride;" 0 "original" } }
  35 ! { dg-final { scan-tree-dump-times "= b1->dim.0..stride;" 0 "original" } }
  36 ! { dg-final { scan-tree-dump-times "= c2->dim.0..stride;" 1 "original" } }
  37 ! { dg-final { scan-tree-dump-times "= d2->dim.0..stride;" 1 "original" } }
  38
  39
  40 subroutine test3()
  41   implicit none
  42   integer :: test3_a(8),i
  43   test3_a = [(i,i=1,8)]
  44   call foo(test3_a(::1))
  45   call foo(test3_a(::2))
  46   call bar(test3_a(::1))
  47   call bar(test3_a(::2))
  48 contains
  49   subroutine foo(x)
  50     integer, contiguous :: x(:)
  51     print *, x
  52   end subroutine
  53   subroutine bar(x)
  54     integer :: x(:)
  55     print *, x
  56   end subroutine bar
  57 end subroutine test3
  58
  59 ! Once for test1 (third call), once for test3 (second call)
  60 ! { dg-final { scan-tree-dump-times "data = origptr" 1 "original" } }
  61 ! { dg-final { scan-tree-dump-times "_gfortran_internal_pack .&parm" 2 "original" } }
  62 ! { dg-final { scan-tree-dump-times "_gfortran_internal_unpack .&parm" 2 "original" } }
  63
  64
  65 ! { dg-final { cleanup-tree-dump "original" } }