1! { dg-do compile } 2! { dg-options "-O0 -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