1! { dg-do run }
2!
3! Contributed by Reinhold Bader
4!
5program assumed_shape_01
6  implicit none
7  type :: cstruct
8     integer :: i
9     real :: r(2)
10  end type cstruct
11
12  type(cstruct), pointer :: u(:)
13  integer, allocatable :: iv(:), iv2(:)
14  integer, allocatable :: im(:,:)
15  integer, parameter :: cim(2,3) = reshape([1,2,3, 2,3,4], [2,3])
16  integer :: i
17  integer, parameter :: lcim(2,10) = reshape([(i, i=1,10),(i,i=1,10)], [2,10])
18
19  allocate(iv, source= [ 1, 2, 3, 4])
20  if (any(iv /= [ 1, 2, 3, 4])) STOP 1
21  deallocate(iv)
22
23  allocate(iv, source=(/(i, i=1,10)/))
24  if (any(iv /= (/(i, i=1,10)/))) STOP 2
25
26  ! Now 2D
27  allocate(im, source= cim)
28  if (any(im /= cim)) STOP 3
29  deallocate(im)
30
31  allocate(im, source= reshape([iv, iv], [2, size(iv, 1)]))
32  if (any(im /= lcim)) STOP 4
33  deallocate(im)
34  deallocate(iv)
35
36  allocate(u, source=[cstruct( 4, [1.1,2.2] )] )
37  if (any(u(:)%i /= 4) .or. any(abs(u(1)%r(:) - [1.1,2.2]) > 1E-6)) STOP 5
38  deallocate (u)
39
40  allocate(iv, source= arrval())
41  if (any(iv /= [ 1, 2, 4, 5, 6])) STOP 6
42  ! Check simple array assign
43  allocate(iv2, source=iv)
44  if (any(iv2 /= [ 1, 2, 4, 5, 6])) STOP 7
45  deallocate(iv, iv2)
46
47  ! Now check for mold=
48  allocate(iv, mold= [ 1, 2, 3, 4])
49  if (any(shape(iv) /= [4])) STOP 8
50  deallocate(iv)
51
52  allocate(iv, mold=(/(i, i=1,10)/))
53  if (any(shape(iv) /= [10])) STOP 9
54
55  ! Now 2D
56  allocate(im, mold= cim)
57  if (any(shape(im) /= shape(cim))) STOP 10
58  deallocate(im)
59
60  allocate(im, mold= reshape([iv, iv], [2, size(iv, 1)]))
61  if (any(shape(im) /= shape(lcim))) STOP 11
62  deallocate(im)
63  deallocate(iv)
64
65  allocate(u, mold=[cstruct( 4, [1.1,2.2] )] )
66  if (any(shape(u(1)%r(:)) /= 2)) STOP 12
67  deallocate (u)
68
69  allocate(iv, mold= arrval())
70  if (any(shape(iv) /= [5])) STOP 13
71  ! Check simple array assign
72  allocate(iv2, mold=iv)
73  if (any(shape(iv2) /= [5])) STOP 14
74  deallocate(iv, iv2)
75
76  call addData([4, 5])
77  call addData(["foo", "bar"])
78contains
79  function arrval()
80    integer, dimension(5) :: arrval
81    arrval = [ 1, 2, 4, 5, 6]
82  end function
83
84  subroutine addData(P)
85    class(*), intent(in) :: P(:)
86    class(*), allocatable :: cP(:)
87    allocate (cP, source= P)
88    select type (cP)
89      type is (integer)
90        if (any(cP /= [4,5])) STOP 15
91      type is (character(*))
92        if (len(cP) /= 3) STOP 16
93        if (any(cP /= ["foo", "bar"])) STOP 17
94      class default
95        STOP 18
96    end select
97    deallocate (cP)
98    allocate (cP, mold= P)
99    select type (cP)
100      type is (integer)
101        if (any(size(cP) /= [2])) STOP 19
102      type is (character(*))
103        if (len(cP) /= 3) STOP 20
104        if (any(size(cP) /= [2])) STOP 21
105      class default
106        STOP 22
107    end select
108    deallocate (cP)
109  end subroutine
110end program assumed_shape_01
111