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  integer, target, dimension(3) :: aa
12  test1_a => aa
13  call foo(test1_a)
14  call foo(test1_a(::1))
15  call foo(test1_a(::2))
16contains
17  subroutine foo(b)
18    integer :: b(*)
19  end subroutine foo
20end subroutine test1
21
22! For the first two no pack is done; for the third one, an array descriptor
23! (cf. below test3) is created for packing.
24!
25! { dg-final { scan-tree-dump-times "_internal_pack.*test1_a" 0 "original" } }
26! { dg-final { scan-tree-dump-times "_internal_unpack.*test1_a" 0 "original" } }
27
28
29subroutine t2(a1,b1,c2,d2)
30  integer, pointer, contiguous :: a1(:), b1(:)
31  integer, pointer :: c2(:), d2(:)
32  a1 = b1
33  c2 = d2
34end subroutine t2
35
36! { dg-final { scan-tree-dump-times "= a1->dim.0..stride;" 0 "original" } }
37! { dg-final { scan-tree-dump-times "= b1->dim.0..stride;" 0 "original" } }
38! { dg-final { scan-tree-dump-times "= c2->dim.0..stride;" 1 "original" } }
39! { dg-final { scan-tree-dump-times "= d2->dim.0..stride;" 1 "original" } }
40
41
42subroutine test3()
43  implicit none
44  integer :: test3_a(8),i
45  test3_a = [(i,i=1,8)]
46  call foo(test3_a(::1))
47  call foo(test3_a(::2))
48  call bar(test3_a(::1))
49  call bar(test3_a(::2))
50contains
51  subroutine foo(x)
52    integer, contiguous :: x(:)
53    print *, x
54  end subroutine
55  subroutine bar(x)
56    integer :: x(:)
57    print *, x
58  end subroutine bar
59end subroutine test3
60
61