| ! { dg-do run } |
| ! |
| ! Contributed by Reinhold Bader |
| ! |
| program assumed_shape_01 |
| implicit none |
| type :: cstruct |
| integer :: i |
| real :: r(2) |
| end type cstruct |
| |
| type(cstruct), pointer :: u(:) |
| integer, allocatable :: iv(:), iv2(:) |
| integer, allocatable :: im(:,:) |
| integer, parameter :: cim(2,3) = reshape([1,2,3, 2,3,4], [2,3]) |
| integer :: i |
| integer, parameter :: lcim(2,10) = reshape([(i, i=1,10),(i,i=1,10)], [2,10]) |
| |
| allocate(iv, source= [ 1, 2, 3, 4]) |
| if (any(iv /= [ 1, 2, 3, 4])) call abort() |
| deallocate(iv) |
| |
| allocate(iv, source=(/(i, i=1,10)/)) |
| if (any(iv /= (/(i, i=1,10)/))) call abort() |
| |
| ! Now 2D |
| allocate(im, source= cim) |
| if (any(im /= cim)) call abort() |
| deallocate(im) |
| |
| allocate(im, source= reshape([iv, iv], [2, size(iv, 1)])) |
| if (any(im /= lcim)) call abort() |
| deallocate(im) |
| deallocate(iv) |
| |
| allocate(u, source=[cstruct( 4, [1.1,2.2] )] ) |
| if (any(u(:)%i /= 4) .or. any(abs(u(1)%r(:) - [1.1,2.2]) > 1E-6)) call abort() |
| deallocate (u) |
| |
| allocate(iv, source= arrval()) |
| if (any(iv /= [ 1, 2, 4, 5, 6])) call abort() |
| ! Check simple array assign |
| allocate(iv2, source=iv) |
| if (any(iv2 /= [ 1, 2, 4, 5, 6])) call abort() |
| deallocate(iv, iv2) |
| |
| ! Now check for mold= |
| allocate(iv, mold= [ 1, 2, 3, 4]) |
| if (any(shape(iv) /= [4])) call abort() |
| deallocate(iv) |
| |
| allocate(iv, mold=(/(i, i=1,10)/)) |
| if (any(shape(iv) /= [10])) call abort() |
| |
| ! Now 2D |
| allocate(im, mold= cim) |
| if (any(shape(im) /= shape(cim))) call abort() |
| deallocate(im) |
| |
| allocate(im, mold= reshape([iv, iv], [2, size(iv, 1)])) |
| if (any(shape(im) /= shape(lcim))) call abort() |
| deallocate(im) |
| deallocate(iv) |
| |
| allocate(u, mold=[cstruct( 4, [1.1,2.2] )] ) |
| if (any(shape(u(1)%r(:)) /= 2)) call abort() |
| deallocate (u) |
| |
| allocate(iv, mold= arrval()) |
| if (any(shape(iv) /= [5])) call abort() |
| ! Check simple array assign |
| allocate(iv2, mold=iv) |
| if (any(shape(iv2) /= [5])) call abort() |
| deallocate(iv, iv2) |
| |
| call addData([4, 5]) |
| call addData(["foo", "bar"]) |
| contains |
| function arrval() |
| integer, dimension(5) :: arrval |
| arrval = [ 1, 2, 4, 5, 6] |
| end function |
| |
| subroutine addData(P) |
| class(*), intent(in) :: P(:) |
| class(*), allocatable :: cP(:) |
| allocate (cP, source= P) |
| select type (cP) |
| type is (integer) |
| if (any(cP /= [4,5])) call abort() |
| type is (character(*)) |
| if (len(cP) /= 3) call abort() |
| if (any(cP /= ["foo", "bar"])) call abort() |
| class default |
| call abort() |
| end select |
| deallocate (cP) |
| allocate (cP, mold= P) |
| select type (cP) |
| type is (integer) |
| if (any(size(cP) /= [2])) call abort() |
| type is (character(*)) |
| if (len(cP) /= 3) call abort() |
| if (any(size(cP) /= [2])) call abort() |
| class default |
| call abort() |
| end select |
| deallocate (cP) |
| end subroutine |
| end program assumed_shape_01 |
