3 ! Contributed by Reinhold Bader
5 program assumed_shape_01
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])
17 integer, parameter :: lcim(2,10) = reshape([(i, i=1,10),(i,i=1,10)], [2,10])
19 allocate(iv, source= [ 1, 2, 3, 4])
20 if (any(iv /= [ 1, 2, 3, 4])) STOP 1
23 allocate(iv, source=(/(i, i=1,10)/))
24 if (any(iv /= (/(i, i=1,10)/))) STOP 2
27 allocate(im, source= cim)
28 if (any(im /= cim)) STOP 3
31 allocate(im, source= reshape([iv, iv], [2, size(iv, 1)]))
32 if (any(im /= lcim)) STOP 4
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
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
48 allocate(iv, mold= [ 1, 2, 3, 4])
49 if (any(shape(iv) /= [4])) STOP 8
52 allocate(iv, mold=(/(i, i=1,10)/))
53 if (any(shape(iv) /= [10])) STOP 9
56 allocate(im, mold= cim)
57 if (any(shape(im) /= shape(cim))) STOP 10
60 allocate(im, mold= reshape([iv, iv], [2, size(iv, 1)]))
61 if (any(shape(im) /= shape(lcim))) STOP 11
65 allocate(u, mold=[cstruct( 4, [1.1,2.2] )] )
66 if (any(shape(u(1)%r(:)) /= 2)) STOP 12
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
77 call addData(["foo", "bar"])
80 integer, dimension(5) :: arrval
81 arrval = [ 1, 2, 4, 5, 6]
85 class(*), intent(in) :: P(:)
86 class(*), allocatable :: cP(:)
87 allocate (cP, source= P)
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
98 allocate (cP, mold= P)
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
110 end program assumed_shape_01