2 ! Testing fix for PR fortran/60289
3 ! Contributed by: Andre Vehreschild <vehre@gmx.de>
8 class(*), pointer :: P1
, P2
, P3
9 class(*), pointer, dimension(:) :: PA1
10 class(*), allocatable
:: A1
, A2
11 integer :: string_len
= 10 *2
12 character(len
=:), allocatable
, target
:: str
13 character(len
=:,kind
=4), allocatable
:: str4
15 class(*), pointer :: content
19 str
= "string for test"
20 str4
= 4_
"string for test"
22 allocate(character(string_len
)::P1
)
25 type is (character(*))
26 P1
="some test string"
27 if (P1
.ne
. "some test string") STOP 1
28 if (len(P1
) .ne
. 20) STOP 2
29 if (len(P1
) .eq
. len("some test string")) STOP 3
34 allocate(A1
, source
= P1
)
37 type is (character(*))
38 if (A1
.ne
. "some test string") STOP 5
39 if (len(A1
) .ne
. 20) STOP 6
40 if (len(A1
) .eq
. len("some test string")) STOP 7
45 allocate(A2
, source
= convertType(P1
))
48 type is (character(*))
49 if (A2
.ne
. "some test string") STOP 9
50 if (len(A2
) .ne
. 20) STOP 10
51 if (len(A2
) .eq
. len("some test string")) STOP 11
56 allocate(P2
, source
= str
)
59 type is (character(*))
60 if (P2
.ne
. "string for test") STOP 13
61 if (len(P2
) .eq
. 20) STOP 14
62 if (len(P2
) .ne
. len("string for test")) STOP 15
67 allocate(P3
, source
= "string for test")
70 type is (character(*))
71 if (P3
.ne
. "string for test") STOP 17
72 if (len(P3
) .eq
. 20) STOP 18
73 if (len(P3
) .ne
. len("string for test")) STOP 19
78 allocate(character(len
=10)::PA1(3))
81 type is (character(*))
83 if (PA1(1) .ne
. "string 10 ") STOP 21
84 if (any(len(PA1(:)) .ne
. [10,10,10])) STOP 22
91 ! if (len(P3) .ne. 0) STOP 24 ! Can't check, because select
92 ! type would be needed, which needs the vptr, which is 0 now.
98 ! Now for kind=4 chars.
100 allocate(character(len
=20,kind
=4)::P1
)
103 type is (character(len
=*,kind
=4))
104 P1
="some test string"
105 if (P1
.ne
. 4_
"some test string") STOP 25
106 if (len(P1
) .ne
. 20) STOP 26
107 if (len(P1
) .eq
. len("some test string")) STOP 27
108 type is (character(len
=*,kind
=1))
114 allocate(A1
, source
=P1
)
117 type is (character(len
=*,kind
=4))
118 if (A1
.ne
. 4_
"some test string") STOP 30
119 if (len(A1
) .ne
. 20) STOP 31
120 if (len(A1
) .eq
. len("some test string")) STOP 32
121 type is (character(len
=*,kind
=1))
127 allocate(A2
, source
= convertType(P1
))
130 type is (character(len
=*, kind
=4))
131 if (A2
.ne
. 4_
"some test string") STOP 35
132 if (len(A2
) .ne
. 20) STOP 36
133 if (len(A2
) .eq
. len("some test string")) STOP 37
138 allocate(P2
, source
= str4
)
141 type is (character(len
=*,kind
=4))
142 if (P2
.ne
. 4_
"string for test") STOP 39
143 if (len(P2
) .eq
. 20) STOP 40
144 if (len(P2
) .ne
. len("string for test")) STOP 41
149 allocate(P3
, source
= convertType(P2
))
152 type is (character(len
=*, kind
=4))
153 if (P3
.ne
. 4_
"string for test") STOP 43
154 if (len(P3
) .eq
. 20) STOP 44
155 if (len(P3
) .ne
. len("string for test")) STOP 45
160 allocate(character(kind
=4, len
=10)::PA1(3))
163 type is (character(len
=*, kind
=4))
164 PA1(1) = 4_
"string 10 "
165 if (PA1(1) .ne
. 4_
"string 10 ") STOP 47
166 if (any(len(PA1(:)) .ne
. [10,10,10])) STOP 48
178 allocate(o1
%content
, source
='test string')
179 allocate(o2
%content
, source
=o1
%content
)
180 select
type (c
=> o1
%content
)
181 type is (character(*))
182 if (c
/= 'test string') STOP 50
186 select
type (d
=> o2
%content
)
187 type is (character(*))
188 if (d
/= 'test string') STOP 52
192 call AddCopy ('test string')
196 function convertType(in
)
197 class(*), pointer, intent(in
) :: in
198 class(*), pointer :: convertType
203 subroutine AddCopy(C
)
204 class(*), intent(in
) :: C
205 class(*), pointer :: P
206 allocate(P
, source
=C
)
208 type is (character(*))
209 if (P
/= 'test string') STOP 53