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
9subroutine 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))
14contains
15  subroutine foo(b)
16    integer :: b(*)
17  end subroutine foo
18end 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
27subroutine t2(a1,b1,c2,d2)
28  integer, pointer, contiguous :: a1(:), b1(:)
29  integer, pointer :: c2(:), d2(:)
30  a1 = b1
31  c2 = d2
32end 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
40subroutine 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))
48contains
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
57end 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" } }
66