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