1! { dg-do run } 2! PR 56789 - packing / unpacking of contiguous arguments 3! did not happen. 4 5module my_module 6 implicit none 7contains 8 subroutine cont_arg(a) 9 real, contiguous :: a(:,:) 10 integer :: i,j 11 do j=1,size(a,2) 12 do i=1,size(a,1) 13 a(i,j) = i+10*j 14 end do 15 end do 16 end subroutine cont_arg 17 subroutine cont_pointer_arg (a) 18 integer, pointer, contiguous :: a(:) 19 call assumed_size(a) 20 call assumed_size(a(::1)) 21 call assumed_size_2(a(::2)) 22 end subroutine cont_pointer_arg 23 24 subroutine assumed_size(y) 25 integer, dimension(*) :: y 26 if (y(2) /= 2 .or. y(3) /= 3 .or. y(4) /= 4 .or. y(5) /= 5 .or. y(6) /= 6) & 27 stop 2 28 end subroutine assumed_size 29 30 subroutine assumed_size_2(y) 31 integer, dimension(*) :: y 32 if (y(1) /= 1 .or. y(2) /= 3 .or. y(3) /= 5) stop 3 33 end subroutine assumed_size_2 34 35 subroutine cont_assumed_shape(x) 36 integer, dimension(:), contiguous :: x 37 if (size(x,1) == 8) then 38 if (any(x /= [1,2,3,4,5,6,7,8])) stop 4 39 else 40 if (any(x /= [1,3,5,7])) stop 5 41 end if 42 end subroutine cont_assumed_shape 43end module my_module 44 45program main 46 use my_module 47 implicit none 48 real, dimension(5,5) :: a 49 real, dimension(5,5) :: res 50 integer, dimension(8), target :: t 51 integer, dimension(:), pointer, contiguous :: p 52 res = reshape([11., 1.,12., 1.,13.,& 53 1., 1., 1., 1., 1.,& 54 21., 1.,22., 1.,23.,& 55 1., 1., 1., 1., 1.,& 56 31., 1.,32., 1., 33.], shape(res)) 57 a = 1. 58 call cont_arg(a(1:5:2,1:5:2)) 59 if (any(a /= res)) stop 1 60 t = [1,2,3,4,5,6,7,8] 61 p => t 62 call cont_pointer_arg(p) 63 call cont_assumed_shape (t) 64 call cont_assumed_shape (t(::2)) 65end program main 66