Commit | Line | Data |
e198f039 |
1 | #!./perl -w |
84902520 |
2 | |
3 | #P = start of string Q = start of substr R = end of substr S = end of string |
a687059c |
4 | |
e476b1b5 |
5 | BEGIN { |
3aa33fe5 |
6 | chdir 't' if -d 't'; |
20822f61 |
7 | @INC = '../lib'; |
e476b1b5 |
8 | } |
9 | use warnings ; |
84902520 |
10 | |
e476b1b5 |
11 | $a = 'abcdefxyz'; |
84902520 |
12 | $SIG{__WARN__} = sub { |
13 | if ($_[0] =~ /^substr outside of string/) { |
14 | $w++; |
15 | } elsif ($_[0] =~ /^Attempt to use reference as lvalue in substr/) { |
16 | $w += 2; |
5d82c453 |
17 | } elsif ($_[0] =~ /^Use of uninitialized value/) { |
18 | $w += 3; |
84902520 |
19 | } else { |
5d82c453 |
20 | warn $_[0]; |
84902520 |
21 | } |
22 | }; |
a687059c |
23 | |
e198f039 |
24 | require './test.pl'; |
25 | |
26 | plan(334); |
e476b1b5 |
27 | |
e198f039 |
28 | $FATAL_MSG = qr/^substr outside of string/; |
84902520 |
29 | |
e198f039 |
30 | is(substr($a,0,3), 'abc'); # P=Q R S |
31 | is(substr($a,3,3), 'def'); # P Q R S |
32 | is(substr($a,6,999), 'xyz'); # P Q S R |
e476b1b5 |
33 | $b = substr($a,999,999) ; # warn # P R Q S |
e198f039 |
34 | is ($w--, 1); |
e476b1b5 |
35 | eval{substr($a,999,999) = "" ; };# P R Q S |
e198f039 |
36 | like ($@, $FATAL_MSG); |
37 | is(substr($a,0,-6), 'abc'); # P=Q R S |
38 | is(substr($a,-3,1), 'x'); # P Q R S |
a687059c |
39 | |
40 | $[ = 1; |
41 | |
e198f039 |
42 | is(substr($a,1,3), 'abc' ); # P=Q R S |
43 | is(substr($a,4,3), 'def' ); # P Q R S |
44 | is(substr($a,7,999), 'xyz');# P Q S R |
e476b1b5 |
45 | $b = substr($a,999,999) ; # warn # P R Q S |
e198f039 |
46 | is($w--, 1); |
e476b1b5 |
47 | eval{substr($a,999,999) = "" ; } ; # P R Q S |
e198f039 |
48 | like ($@, $FATAL_MSG); |
49 | is(substr($a,1,-6), 'abc' );# P=Q R S |
50 | is(substr($a,-3,1), 'x' ); # P Q R S |
a687059c |
51 | |
52 | $[ = 0; |
53 | |
54 | substr($a,3,3) = 'XYZ'; |
e198f039 |
55 | is($a, 'abcXYZxyz' ); |
a687059c |
56 | substr($a,0,2) = ''; |
e198f039 |
57 | is($a, 'cXYZxyz' ); |
a687059c |
58 | substr($a,0,0) = 'ab'; |
e198f039 |
59 | is($a, 'abcXYZxyz' ); |
a687059c |
60 | substr($a,0,0) = '12345678'; |
e198f039 |
61 | is($a, '12345678abcXYZxyz' ); |
a687059c |
62 | substr($a,-3,3) = 'def'; |
e198f039 |
63 | is($a, '12345678abcXYZdef'); |
a687059c |
64 | substr($a,-3,3) = '<'; |
e198f039 |
65 | is($a, '12345678abcXYZ<' ); |
a687059c |
66 | substr($a,-1,1) = '12345678'; |
e198f039 |
67 | is($a, '12345678abcXYZ12345678' ); |
a687059c |
68 | |
d9d8d8de |
69 | $a = 'abcdefxyz'; |
70 | |
e198f039 |
71 | is(substr($a,6), 'xyz' ); # P Q R=S |
72 | is(substr($a,-3), 'xyz' ); # P Q R=S |
e476b1b5 |
73 | $b = substr($a,999,999) ; # warning # P R=S Q |
e198f039 |
74 | is($w--, 1); |
e476b1b5 |
75 | eval{substr($a,999,999) = "" ; } ; # P R=S Q |
e198f039 |
76 | like($@, $FATAL_MSG); |
77 | is(substr($a,0), 'abcdefxyz'); # P=Q R=S |
78 | is(substr($a,9), ''); # P Q=R=S |
79 | is(substr($a,-11), 'abcdefxyz'); # Q P R=S |
80 | is(substr($a,-9), 'abcdefxyz'); # P=Q R=S |
84902520 |
81 | |
82 | $a = '54321'; |
83 | |
e476b1b5 |
84 | $b = substr($a,-7, 1) ; # warn # Q R P S |
e198f039 |
85 | is($w--, 1); |
e476b1b5 |
86 | eval{substr($a,-7, 1) = "" ; }; # Q R P S |
e198f039 |
87 | like($@, $FATAL_MSG); |
e476b1b5 |
88 | $b = substr($a,-7,-6) ; # warn # Q R P S |
e198f039 |
89 | is($w--, 1); |
e476b1b5 |
90 | eval{substr($a,-7,-6) = "" ; }; # Q R P S |
e198f039 |
91 | like($@, $FATAL_MSG); |
92 | is(substr($a,-5,-7), ''); # R P=Q S |
93 | is(substr($a, 2,-7), ''); # R P Q S |
94 | is(substr($a,-3,-7), ''); # R P Q S |
95 | is(substr($a, 2,-5), ''); # P=R Q S |
96 | is(substr($a,-3,-5), ''); # P=R Q S |
97 | is(substr($a, 2,-4), ''); # P R Q S |
98 | is(substr($a,-3,-4), ''); # P R Q S |
99 | is(substr($a, 5,-6), ''); # R P Q=S |
100 | is(substr($a, 5,-5), ''); # P=R Q S |
101 | is(substr($a, 5,-3), ''); # P R Q=S |
e476b1b5 |
102 | $b = substr($a, 7,-7) ; # warn # R P S Q |
e198f039 |
103 | is($w--, 1); |
e476b1b5 |
104 | eval{substr($a, 7,-7) = "" ; }; # R P S Q |
e198f039 |
105 | like($@, $FATAL_MSG); |
e476b1b5 |
106 | $b = substr($a, 7,-5) ; # warn # P=R S Q |
e198f039 |
107 | is($w--, 1); |
e476b1b5 |
108 | eval{substr($a, 7,-5) = "" ; }; # P=R S Q |
e198f039 |
109 | like($@, $FATAL_MSG); |
e476b1b5 |
110 | $b = substr($a, 7,-3) ; # warn # P Q S Q |
e198f039 |
111 | is($w--, 1); |
e476b1b5 |
112 | eval{substr($a, 7,-3) = "" ; }; # P Q S Q |
e198f039 |
113 | like($@, $FATAL_MSG); |
e476b1b5 |
114 | $b = substr($a, 7, 0) ; # warn # P S Q=R |
e198f039 |
115 | is($w--, 1); |
e476b1b5 |
116 | eval{substr($a, 7, 0) = "" ; }; # P S Q=R |
e198f039 |
117 | like($@, $FATAL_MSG); |
118 | |
119 | is(substr($a,-7,2), ''); # Q P=R S |
120 | is(substr($a,-7,4), '54'); # Q P R S |
121 | is(substr($a,-7,7), '54321');# Q P R=S |
122 | is(substr($a,-7,9), '54321');# Q P S R |
123 | is(substr($a,-5,0), ''); # P=Q=R S |
124 | is(substr($a,-5,3), '543');# P=Q R S |
125 | is(substr($a,-5,5), '54321');# P=Q R=S |
126 | is(substr($a,-5,7), '54321');# P=Q S R |
127 | is(substr($a,-3,0), ''); # P Q=R S |
128 | is(substr($a,-3,3), '321');# P Q R=S |
129 | is(substr($a,-2,3), '21'); # P Q S R |
130 | is(substr($a,0,-5), ''); # P=Q=R S |
131 | is(substr($a,2,-3), ''); # P Q=R S |
132 | is(substr($a,0,0), ''); # P=Q=R S |
133 | is(substr($a,0,5), '54321');# P=Q R=S |
134 | is(substr($a,0,7), '54321');# P=Q S R |
135 | is(substr($a,2,0), ''); # P Q=R S |
136 | is(substr($a,2,3), '321'); # P Q R=S |
137 | is(substr($a,5,0), ''); # P Q=R=S |
138 | is(substr($a,5,2), ''); # P Q=S R |
139 | is(substr($a,-7,-5), ''); # Q P=R S |
140 | is(substr($a,-7,-2), '543');# Q P R S |
141 | is(substr($a,-5,-5), ''); # P=Q=R S |
142 | is(substr($a,-5,-2), '543');# P=Q R S |
143 | is(substr($a,-3,-3), ''); # P Q=R S |
144 | is(substr($a,-3,-1), '32');# P Q R S |
84902520 |
145 | |
146 | $a = ''; |
147 | |
e198f039 |
148 | is(substr($a,-2,2), ''); # Q P=R=S |
149 | is(substr($a,0,0), ''); # P=Q=R=S |
150 | is(substr($a,0,1), ''); # P=Q=S R |
151 | is(substr($a,-2,3), ''); # Q P=S R |
152 | is(substr($a,-2), ''); # Q P=R=S |
153 | is(substr($a,0), ''); # P=Q=R=S |
e476b1b5 |
154 | |
155 | |
e198f039 |
156 | is(substr($a,0,-1), ''); # R P=Q=S |
e476b1b5 |
157 | $b = substr($a,-2, 0) ; # warn # Q=R P=S |
e198f039 |
158 | is($w--, 1); |
e476b1b5 |
159 | eval{substr($a,-2, 0) = "" ; }; # Q=R P=S |
e198f039 |
160 | like($@, $FATAL_MSG); |
84902520 |
161 | |
e476b1b5 |
162 | $b = substr($a,-2, 1) ; # warn # Q R P=S |
e198f039 |
163 | is($w--, 1); |
e476b1b5 |
164 | eval{substr($a,-2, 1) = "" ; }; # Q R P=S |
e198f039 |
165 | like($@, $FATAL_MSG); |
84902520 |
166 | |
e476b1b5 |
167 | $b = substr($a,-2,-1) ; # warn # Q R P=S |
e198f039 |
168 | is($w--, 1); |
e476b1b5 |
169 | eval{substr($a,-2,-1) = "" ; }; # Q R P=S |
e198f039 |
170 | like($@, $FATAL_MSG); |
84902520 |
171 | |
e476b1b5 |
172 | $b = substr($a,-2,-2) ; # warn # Q=R P=S |
e198f039 |
173 | is($w--, 1); |
e476b1b5 |
174 | eval{substr($a,-2,-2) = "" ; }; # Q=R P=S |
e198f039 |
175 | like($@, $FATAL_MSG); |
e476b1b5 |
176 | |
177 | $b = substr($a, 1,-2) ; # warn # R P=S Q |
e198f039 |
178 | is($w--, 1); |
e476b1b5 |
179 | eval{substr($a, 1,-2) = "" ; }; # R P=S Q |
e198f039 |
180 | like($@, $FATAL_MSG); |
e476b1b5 |
181 | |
182 | $b = substr($a, 1, 1) ; # warn # P=S Q R |
e198f039 |
183 | is($w--, 1); |
e476b1b5 |
184 | eval{substr($a, 1, 1) = "" ; }; # P=S Q R |
e198f039 |
185 | like($@, $FATAL_MSG); |
e476b1b5 |
186 | |
187 | $b = substr($a, 1, 0) ;# warn # P=S Q=R |
e198f039 |
188 | is($w--, 1); |
e476b1b5 |
189 | eval{substr($a, 1, 0) = "" ; }; # P=S Q=R |
e198f039 |
190 | like($@, $FATAL_MSG); |
e476b1b5 |
191 | |
192 | $b = substr($a,1) ; # warning # P=R=S Q |
e198f039 |
193 | is($w--, 1); |
e476b1b5 |
194 | eval{substr($a,1) = "" ; }; # P=R=S Q |
e198f039 |
195 | like($@, $FATAL_MSG); |
84902520 |
196 | |
197 | my $a = 'zxcvbnm'; |
198 | substr($a,2,0) = ''; |
e198f039 |
199 | is($a, 'zxcvbnm'); |
84902520 |
200 | substr($a,7,0) = ''; |
e198f039 |
201 | is($a, 'zxcvbnm'); |
84902520 |
202 | substr($a,5,0) = ''; |
e198f039 |
203 | is($a, 'zxcvbnm'); |
84902520 |
204 | substr($a,0,2) = 'pq'; |
e198f039 |
205 | is($a, 'pqcvbnm'); |
84902520 |
206 | substr($a,2,0) = 'r'; |
e198f039 |
207 | is($a, 'pqrcvbnm'); |
84902520 |
208 | substr($a,8,0) = 'asd'; |
e198f039 |
209 | is($a, 'pqrcvbnmasd'); |
84902520 |
210 | substr($a,0,2) = 'iop'; |
e198f039 |
211 | is($a, 'ioprcvbnmasd'); |
84902520 |
212 | substr($a,0,5) = 'fgh'; |
e198f039 |
213 | is($a, 'fghvbnmasd'); |
84902520 |
214 | substr($a,3,5) = 'jkl'; |
e198f039 |
215 | is($a, 'fghjklsd'); |
84902520 |
216 | substr($a,3,2) = '1234'; |
e198f039 |
217 | is($a, 'fgh1234lsd'); |
84902520 |
218 | |
08cb0b0d |
219 | |
220 | # with lexicals (and in re-entered scopes) |
221 | for (0,1) { |
222 | my $txt; |
223 | unless ($_) { |
224 | $txt = "Foo"; |
225 | substr($txt, -1) = "X"; |
e198f039 |
226 | is($txt, "FoX"); |
08cb0b0d |
227 | } |
228 | else { |
229 | substr($txt, 0, 1) = "X"; |
e198f039 |
230 | is($txt, "X"); |
08cb0b0d |
231 | } |
232 | } |
233 | |
e476b1b5 |
234 | $w = 0 ; |
84902520 |
235 | # coercion of references |
08cb0b0d |
236 | { |
237 | my $s = []; |
238 | substr($s, 0, 1) = 'Foo'; |
e198f039 |
239 | is (substr($s,0,7), "FooRRAY"); |
240 | is ($w,2); |
241 | $w = 0; |
08cb0b0d |
242 | } |
84902520 |
243 | |
244 | # check no spurious warnings |
e198f039 |
245 | is($w, 0); |
7b8d334a |
246 | |
5d82c453 |
247 | # check new 4 arg replacement syntax |
7b8d334a |
248 | $a = "abcxyz"; |
5d82c453 |
249 | $w = 0; |
e198f039 |
250 | is(substr($a, 0, 3, ""), "abc"); |
251 | is($a, "xyz"); |
252 | is(substr($a, 0, 0, "abc"), ""); |
253 | is($a, "abcxyz"); |
254 | is(substr($a, 3, -1, ""), "xy"); |
255 | is($a, "abcz"); |
e476b1b5 |
256 | |
e198f039 |
257 | is(substr($a, 3, undef, "xy"), ""); |
258 | is($a, "abcxyz"); |
259 | is($w, 3); |
e476b1b5 |
260 | |
5d82c453 |
261 | $w = 0; |
262 | |
e198f039 |
263 | is(substr($a, 3, 9999999, ""), "xyz"); |
264 | is($a, "abc"); |
e476b1b5 |
265 | eval{substr($a, -99, 0, "") }; |
e198f039 |
266 | like($@, $FATAL_MSG); |
e476b1b5 |
267 | eval{substr($a, 99, 3, "") }; |
e198f039 |
268 | like($@, $FATAL_MSG); |
5d82c453 |
269 | |
270 | substr($a, 0, length($a), "foo"); |
e198f039 |
271 | is ($a, "foo"); |
272 | is ($w, 0); |
5d82c453 |
273 | |
274 | # using 4 arg substr as lvalue is a compile time error |
275 | eval 'substr($a,0,0,"") = "abc"'; |
e198f039 |
276 | like ($@, qr/Can't modify substr/); |
277 | is ($a, "foo"); |
c8faf1c5 |
278 | |
279 | $a = "abcdefgh"; |
e198f039 |
280 | is(sub { shift }->(substr($a, 0, 4, "xxxx")), 'abcd'); |
281 | is($a, 'xxxxefgh'); |
7f66633b |
282 | |
e84ff256 |
283 | { |
284 | my $y = 10; |
285 | $y = "2" . $y; |
e198f039 |
286 | is ($y, 210); |
e84ff256 |
287 | } |
288 | |
7f66633b |
289 | # utf8 sanity |
290 | { |
291 | my $x = substr("a\x{263a}b",0); |
e198f039 |
292 | is(length($x), 3); |
7f66633b |
293 | $x = substr($x,1,1); |
e198f039 |
294 | is($x, "\x{263a}"); |
dfcb284a |
295 | $x = $x x 2; |
e198f039 |
296 | is(length($x), 2); |
7f66633b |
297 | substr($x,0,1) = "abcd"; |
e198f039 |
298 | is($x, "abcd\x{263a}"); |
299 | is(length($x), 5); |
e84ff256 |
300 | $x = reverse $x; |
e198f039 |
301 | is(length($x), 5); |
302 | is($x, "\x{263a}dcba"); |
e84ff256 |
303 | |
304 | my $z = 10; |
305 | $z = "21\x{263a}" . $z; |
e198f039 |
306 | is(length($z), 5); |
307 | is($z, "21\x{263a}10"); |
7f66633b |
308 | } |
35fba0d9 |
309 | |
310 | # replacement should work on magical values |
311 | require Tie::Scalar; |
312 | my %data; |
313 | tie $data{'a'}, 'Tie::StdScalar'; # makes $data{'a'} magical |
314 | $data{a} = "firstlast"; |
e198f039 |
315 | is(substr($data{'a'}, 0, 5, ""), "first"); |
316 | is($data{'a'}, "last"); |
075a4a2b |
317 | |
318 | # more utf8 |
319 | |
320 | # The following two originally from Ignasi Roca. |
321 | |
322 | $x = "\xF1\xF2\xF3"; |
323 | substr($x, 0, 1) = "\x{100}"; # Ignasi had \x{FF} |
e198f039 |
324 | is(length($x), 3); |
325 | is($x, "\x{100}\xF2\xF3"); |
326 | is(substr($x, 0, 1), "\x{100}"); |
327 | is(substr($x, 1, 1), "\x{F2}"); |
328 | is(substr($x, 2, 1), "\x{F3}"); |
075a4a2b |
329 | |
330 | $x = "\xF1\xF2\xF3"; |
331 | substr($x, 0, 1) = "\x{100}\x{FF}"; # Ignasi had \x{FF} |
e198f039 |
332 | is(length($x), 4); |
333 | is($x, "\x{100}\x{FF}\xF2\xF3"); |
334 | is(substr($x, 0, 1), "\x{100}"); |
335 | is(substr($x, 1, 1), "\x{FF}"); |
336 | is(substr($x, 2, 1), "\x{F2}"); |
337 | is(substr($x, 3, 1), "\x{F3}"); |
075a4a2b |
338 | |
339 | # more utf8 lval exercise |
340 | |
341 | $x = "\xF1\xF2\xF3"; |
342 | substr($x, 0, 2) = "\x{100}\xFF"; |
e198f039 |
343 | is(length($x), 3); |
344 | is($x, "\x{100}\xFF\xF3"); |
345 | is(substr($x, 0, 1), "\x{100}"); |
346 | is(substr($x, 1, 1), "\x{FF}"); |
347 | is(substr($x, 2, 1), "\x{F3}"); |
075a4a2b |
348 | |
349 | $x = "\xF1\xF2\xF3"; |
350 | substr($x, 1, 1) = "\x{100}\xFF"; |
e198f039 |
351 | is(length($x), 4); |
352 | is($x, "\xF1\x{100}\xFF\xF3"); |
353 | is(substr($x, 0, 1), "\x{F1}"); |
354 | is(substr($x, 1, 1), "\x{100}"); |
355 | is(substr($x, 2, 1), "\x{FF}"); |
356 | is(substr($x, 3, 1), "\x{F3}"); |
075a4a2b |
357 | |
358 | $x = "\xF1\xF2\xF3"; |
359 | substr($x, 2, 1) = "\x{100}\xFF"; |
e198f039 |
360 | is(length($x), 4); |
361 | is($x, "\xF1\xF2\x{100}\xFF"); |
362 | is(substr($x, 0, 1), "\x{F1}"); |
363 | is(substr($x, 1, 1), "\x{F2}"); |
364 | is(substr($x, 2, 1), "\x{100}"); |
365 | is(substr($x, 3, 1), "\x{FF}"); |
075a4a2b |
366 | |
367 | $x = "\xF1\xF2\xF3"; |
368 | substr($x, 3, 1) = "\x{100}\xFF"; |
e198f039 |
369 | is(length($x), 5); |
370 | is($x, "\xF1\xF2\xF3\x{100}\xFF"); |
371 | is(substr($x, 0, 1), "\x{F1}"); |
372 | is(substr($x, 1, 1), "\x{F2}"); |
373 | is(substr($x, 2, 1), "\x{F3}"); |
374 | is(substr($x, 3, 1), "\x{100}"); |
375 | is(substr($x, 4, 1), "\x{FF}"); |
075a4a2b |
376 | |
377 | $x = "\xF1\xF2\xF3"; |
378 | substr($x, -1, 1) = "\x{100}\xFF"; |
e198f039 |
379 | is(length($x), 4); |
380 | is($x, "\xF1\xF2\x{100}\xFF"); |
381 | is(substr($x, 0, 1), "\x{F1}"); |
382 | is(substr($x, 1, 1), "\x{F2}"); |
383 | is(substr($x, 2, 1), "\x{100}"); |
384 | is(substr($x, 3, 1), "\x{FF}"); |
075a4a2b |
385 | |
386 | $x = "\xF1\xF2\xF3"; |
387 | substr($x, -1, 0) = "\x{100}\xFF"; |
e198f039 |
388 | is(length($x), 5); |
389 | is($x, "\xF1\xF2\x{100}\xFF\xF3"); |
390 | is(substr($x, 0, 1), "\x{F1}"); |
391 | is(substr($x, 1, 1), "\x{F2}"); |
392 | is(substr($x, 2, 1), "\x{100}"); |
393 | is(substr($x, 3, 1), "\x{FF}"); |
394 | is(substr($x, 4, 1), "\x{F3}"); |
075a4a2b |
395 | |
396 | $x = "\xF1\xF2\xF3"; |
397 | substr($x, 0, -1) = "\x{100}\xFF"; |
e198f039 |
398 | is(length($x), 3); |
399 | is($x, "\x{100}\xFF\xF3"); |
400 | is(substr($x, 0, 1), "\x{100}"); |
401 | is(substr($x, 1, 1), "\x{FF}"); |
402 | is(substr($x, 2, 1), "\x{F3}"); |
075a4a2b |
403 | |
404 | $x = "\xF1\xF2\xF3"; |
405 | substr($x, 0, -2) = "\x{100}\xFF"; |
e198f039 |
406 | is(length($x), 4); |
407 | is($x, "\x{100}\xFF\xF2\xF3"); |
408 | is(substr($x, 0, 1), "\x{100}"); |
409 | is(substr($x, 1, 1), "\x{FF}"); |
410 | is(substr($x, 2, 1), "\x{F2}"); |
411 | is(substr($x, 3, 1), "\x{F3}"); |
075a4a2b |
412 | |
413 | $x = "\xF1\xF2\xF3"; |
414 | substr($x, 0, -3) = "\x{100}\xFF"; |
e198f039 |
415 | is(length($x), 5); |
416 | is($x, "\x{100}\xFF\xF1\xF2\xF3"); |
417 | is(substr($x, 0, 1), "\x{100}"); |
418 | is(substr($x, 1, 1), "\x{FF}"); |
419 | is(substr($x, 2, 1), "\x{F1}"); |
420 | is(substr($x, 3, 1), "\x{F2}"); |
421 | is(substr($x, 4, 1), "\x{F3}"); |
075a4a2b |
422 | |
423 | $x = "\xF1\xF2\xF3"; |
424 | substr($x, 1, -1) = "\x{100}\xFF"; |
e198f039 |
425 | is(length($x), 4); |
426 | is($x, "\xF1\x{100}\xFF\xF3"); |
427 | is(substr($x, 0, 1), "\x{F1}"); |
428 | is(substr($x, 1, 1), "\x{100}"); |
429 | is(substr($x, 2, 1), "\x{FF}"); |
430 | is(substr($x, 3, 1), "\x{F3}"); |
075a4a2b |
431 | |
432 | $x = "\xF1\xF2\xF3"; |
433 | substr($x, -1, -1) = "\x{100}\xFF"; |
e198f039 |
434 | is(length($x), 5); |
435 | is($x, "\xF1\xF2\x{100}\xFF\xF3"); |
436 | is(substr($x, 0, 1), "\x{F1}"); |
437 | is(substr($x, 1, 1), "\x{F2}"); |
438 | is(substr($x, 2, 1), "\x{100}"); |
439 | is(substr($x, 3, 1), "\x{FF}"); |
440 | is(substr($x, 4, 1), "\x{F3}"); |
075a4a2b |
441 | |
9aa983d2 |
442 | # And tests for already-UTF8 one |
443 | |
444 | $x = "\x{101}\x{F2}\x{F3}"; |
445 | substr($x, 0, 1) = "\x{100}"; |
e198f039 |
446 | is(length($x), 3); |
447 | is($x, "\x{100}\xF2\xF3"); |
448 | is(substr($x, 0, 1), "\x{100}"); |
449 | is(substr($x, 1, 1), "\x{F2}"); |
450 | is(substr($x, 2, 1), "\x{F3}"); |
9aa983d2 |
451 | |
452 | $x = "\x{101}\x{F2}\x{F3}"; |
453 | substr($x, 0, 1) = "\x{100}\x{FF}"; |
e198f039 |
454 | is(length($x), 4); |
455 | is($x, "\x{100}\x{FF}\xF2\xF3"); |
456 | is(substr($x, 0, 1), "\x{100}"); |
457 | is(substr($x, 1, 1), "\x{FF}"); |
458 | is(substr($x, 2, 1), "\x{F2}"); |
459 | is(substr($x, 3, 1), "\x{F3}"); |
9aa983d2 |
460 | |
461 | $x = "\x{101}\x{F2}\x{F3}"; |
462 | substr($x, 0, 2) = "\x{100}\xFF"; |
e198f039 |
463 | is(length($x), 3); |
464 | is($x, "\x{100}\xFF\xF3"); |
465 | is(substr($x, 0, 1), "\x{100}"); |
466 | is(substr($x, 1, 1), "\x{FF}"); |
467 | is(substr($x, 2, 1), "\x{F3}"); |
9aa983d2 |
468 | |
469 | $x = "\x{101}\x{F2}\x{F3}"; |
470 | substr($x, 1, 1) = "\x{100}\xFF"; |
e198f039 |
471 | is(length($x), 4); |
472 | is($x, "\x{101}\x{100}\xFF\xF3"); |
473 | is(substr($x, 0, 1), "\x{101}"); |
474 | is(substr($x, 1, 1), "\x{100}"); |
475 | is(substr($x, 2, 1), "\x{FF}"); |
476 | is(substr($x, 3, 1), "\x{F3}"); |
9aa983d2 |
477 | |
478 | $x = "\x{101}\x{F2}\x{F3}"; |
479 | substr($x, 2, 1) = "\x{100}\xFF"; |
e198f039 |
480 | is(length($x), 4); |
481 | is($x, "\x{101}\xF2\x{100}\xFF"); |
482 | is(substr($x, 0, 1), "\x{101}"); |
483 | is(substr($x, 1, 1), "\x{F2}"); |
484 | is(substr($x, 2, 1), "\x{100}"); |
485 | is(substr($x, 3, 1), "\x{FF}"); |
9aa983d2 |
486 | |
487 | $x = "\x{101}\x{F2}\x{F3}"; |
488 | substr($x, 3, 1) = "\x{100}\xFF"; |
e198f039 |
489 | is(length($x), 5); |
490 | is($x, "\x{101}\x{F2}\x{F3}\x{100}\xFF"); |
491 | is(substr($x, 0, 1), "\x{101}"); |
492 | is(substr($x, 1, 1), "\x{F2}"); |
493 | is(substr($x, 2, 1), "\x{F3}"); |
494 | is(substr($x, 3, 1), "\x{100}"); |
495 | is(substr($x, 4, 1), "\x{FF}"); |
9aa983d2 |
496 | |
497 | $x = "\x{101}\x{F2}\x{F3}"; |
498 | substr($x, -1, 1) = "\x{100}\xFF"; |
e198f039 |
499 | is(length($x), 4); |
500 | is($x, "\x{101}\xF2\x{100}\xFF"); |
501 | is(substr($x, 0, 1), "\x{101}"); |
502 | is(substr($x, 1, 1), "\x{F2}"); |
503 | is(substr($x, 2, 1), "\x{100}"); |
504 | is(substr($x, 3, 1), "\x{FF}"); |
9aa983d2 |
505 | |
506 | $x = "\x{101}\x{F2}\x{F3}"; |
507 | substr($x, -1, 0) = "\x{100}\xFF"; |
e198f039 |
508 | is(length($x), 5); |
509 | is($x, "\x{101}\xF2\x{100}\xFF\xF3"); |
510 | is(substr($x, 0, 1), "\x{101}"); |
511 | is(substr($x, 1, 1), "\x{F2}"); |
512 | is(substr($x, 2, 1), "\x{100}"); |
513 | is(substr($x, 3, 1), "\x{FF}"); |
514 | is(substr($x, 4, 1), "\x{F3}"); |
9aa983d2 |
515 | |
516 | $x = "\x{101}\x{F2}\x{F3}"; |
517 | substr($x, 0, -1) = "\x{100}\xFF"; |
e198f039 |
518 | is(length($x), 3); |
519 | is($x, "\x{100}\xFF\xF3"); |
520 | is(substr($x, 0, 1), "\x{100}"); |
521 | is(substr($x, 1, 1), "\x{FF}"); |
522 | is(substr($x, 2, 1), "\x{F3}"); |
9aa983d2 |
523 | |
524 | $x = "\x{101}\x{F2}\x{F3}"; |
525 | substr($x, 0, -2) = "\x{100}\xFF"; |
e198f039 |
526 | is(length($x), 4); |
527 | is($x, "\x{100}\xFF\xF2\xF3"); |
528 | is(substr($x, 0, 1), "\x{100}"); |
529 | is(substr($x, 1, 1), "\x{FF}"); |
530 | is(substr($x, 2, 1), "\x{F2}"); |
531 | is(substr($x, 3, 1), "\x{F3}"); |
9aa983d2 |
532 | |
533 | $x = "\x{101}\x{F2}\x{F3}"; |
534 | substr($x, 0, -3) = "\x{100}\xFF"; |
e198f039 |
535 | is(length($x), 5); |
536 | is($x, "\x{100}\xFF\x{101}\x{F2}\x{F3}"); |
537 | is(substr($x, 0, 1), "\x{100}"); |
538 | is(substr($x, 1, 1), "\x{FF}"); |
539 | is(substr($x, 2, 1), "\x{101}"); |
540 | is(substr($x, 3, 1), "\x{F2}"); |
541 | is(substr($x, 4, 1), "\x{F3}"); |
9aa983d2 |
542 | |
543 | $x = "\x{101}\x{F2}\x{F3}"; |
544 | substr($x, 1, -1) = "\x{100}\xFF"; |
e198f039 |
545 | is(length($x), 4); |
546 | is($x, "\x{101}\x{100}\xFF\xF3"); |
547 | is(substr($x, 0, 1), "\x{101}"); |
548 | is(substr($x, 1, 1), "\x{100}"); |
549 | is(substr($x, 2, 1), "\x{FF}"); |
550 | is(substr($x, 3, 1), "\x{F3}"); |
9aa983d2 |
551 | |
552 | $x = "\x{101}\x{F2}\x{F3}"; |
553 | substr($x, -1, -1) = "\x{100}\xFF"; |
e198f039 |
554 | is(length($x), 5); |
555 | is($x, "\x{101}\xF2\x{100}\xFF\xF3"); |
556 | is(substr($x, 0, 1), "\x{101}"); |
557 | is(substr($x, 1, 1), "\x{F2}"); |
558 | is(substr($x, 2, 1), "\x{100}"); |
559 | is(substr($x, 3, 1), "\x{FF}"); |
560 | is(substr($x, 4, 1), "\x{F3}"); |
f7928d6c |
561 | |
562 | substr($x = "ab", 0, 0, "\x{100}\x{200}"); |
e198f039 |
563 | is($x, "\x{100}\x{200}ab"); |
f7928d6c |
564 | |
565 | substr($x = "\x{100}\x{200}", 0, 0, "ab"); |
e198f039 |
566 | is($x, "ab\x{100}\x{200}"); |
f7928d6c |
567 | |
568 | substr($x = "ab", 1, 0, "\x{100}\x{200}"); |
e198f039 |
569 | is($x, "a\x{100}\x{200}b"); |
f7928d6c |
570 | |
571 | substr($x = "\x{100}\x{200}", 1, 0, "ab"); |
e198f039 |
572 | is($x, "\x{100}ab\x{200}"); |
f7928d6c |
573 | |
574 | substr($x = "ab", 2, 0, "\x{100}\x{200}"); |
e198f039 |
575 | is($x, "ab\x{100}\x{200}"); |
f7928d6c |
576 | |
577 | substr($x = "\x{100}\x{200}", 2, 0, "ab"); |
e198f039 |
578 | is($x, "\x{100}\x{200}ab"); |
f7928d6c |
579 | |
9402d6ed |
580 | substr($x = "\xFFb", 0, 0, "\x{100}\x{200}"); |
e198f039 |
581 | is($x, "\x{100}\x{200}\xFFb"); |
9402d6ed |
582 | |
583 | substr($x = "\x{100}\x{200}", 0, 0, "\xFFb"); |
e198f039 |
584 | is($x, "\xFFb\x{100}\x{200}"); |
9402d6ed |
585 | |
586 | substr($x = "\xFFb", 1, 0, "\x{100}\x{200}"); |
e198f039 |
587 | is($x, "\xFF\x{100}\x{200}b"); |
9402d6ed |
588 | |
589 | substr($x = "\x{100}\x{200}", 1, 0, "\xFFb"); |
e198f039 |
590 | is($x, "\x{100}\xFFb\x{200}"); |
9402d6ed |
591 | |
592 | substr($x = "\xFFb", 2, 0, "\x{100}\x{200}"); |
e198f039 |
593 | is($x, "\xFFb\x{100}\x{200}"); |
9402d6ed |
594 | |
595 | substr($x = "\x{100}\x{200}", 2, 0, "\xFFb"); |
e198f039 |
596 | is($x, "\x{100}\x{200}\xFFb"); |
9402d6ed |
597 | |
24aef97f |
598 | # [perl #20933] |
599 | { |
600 | my $s = "ab"; |
601 | my @r; |
602 | $r[$_] = \ substr $s, $_, 1 for (0, 1); |
e198f039 |
603 | is(join("", map { $$_ } @r), "ab"); |
24aef97f |
604 | } |
6214ab63 |
605 | |
606 | # [perl #23207] |
607 | { |
608 | sub ss { |
609 | substr($_[0],0,1) ^= substr($_[0],1,1) ^= |
610 | substr($_[0],0,1) ^= substr($_[0],1,1); |
611 | } |
612 | my $x = my $y = 'AB'; ss $x; ss $y; |
e198f039 |
613 | is($x, $y); |
6214ab63 |
614 | } |
8f78557a |
615 | |
616 | # [perl #24605] |
617 | { |
618 | my $x = "0123456789\x{500}"; |
619 | my $y = substr $x, 4; |
e198f039 |
620 | is(substr($x, 7, 1), "7"); |
8f78557a |
621 | } |
c2552146 |
622 | |
623 | # multiple assignments to lvalue [perl #24346] |
624 | { |
625 | my $x = "abcdef"; |
626 | for (substr($x,1,3)) { |
e198f039 |
627 | is($_, 'bcd'); |
c2552146 |
628 | $_ = 'XX'; |
e198f039 |
629 | is($_, 'XX'); |
630 | is($x, 'aXXef'); |
c2552146 |
631 | $_ = "\xFF"; |
e198f039 |
632 | is($_, "\xFF"); |
633 | is($x, "a\xFFef"); |
c2552146 |
634 | $_ = "\xF1\xF2\xF3\xF4\xF5\xF6"; |
e198f039 |
635 | is($_, "\xF1\xF2\xF3\xF4\xF5\xF6"); |
636 | is($x, "a\xF1\xF2\xF3\xF4\xF5\xF6ef"); |
c2552146 |
637 | $_ = 'YYYY'; |
e198f039 |
638 | is($_, 'YYYY'); |
639 | is($x, 'aYYYYef'); |
c2552146 |
640 | } |
641 | } |
781e7547 |
642 | |
643 | # [perl #24200] string corruption with lvalue sub |
644 | |
645 | { |
646 | my $foo = "a"; |
647 | sub bar: lvalue { substr $foo, 0 } |
648 | bar = "XXX"; |
e198f039 |
649 | is(bar, 'XXX'); |
781e7547 |
650 | $foo = '123456789'; |
e198f039 |
651 | is(bar, '123456789'); |
781e7547 |
652 | } |
a67d7df9 |
653 | |
654 | # [perl #29149] |
655 | { |
656 | my $text = "0123456789\xED "; |
657 | utf8::upgrade($text); |
658 | my $pos = 5; |
659 | pos($text) = $pos; |
660 | my $a = substr($text, $pos, $pos); |
e198f039 |
661 | is(substr($text,$pos,1), $pos); |
a67d7df9 |
662 | |
663 | } |
080534f4 |
664 | |
665 | # [perl #23765] |
666 | { |
667 | my $a = pack("C", 0xbf); |
668 | substr($a, -1) &= chr(0xfeff); |
e198f039 |
669 | is($a, "\xbf"); |
080534f4 |
670 | } |
ec062429 |
671 | |
672 | # [perl #34976] incorrect caching of utf8 substr length |
673 | { |
674 | my $a = "abcd\x{100}"; |
e198f039 |
675 | is(substr($a,1,2), 'bc'); |
676 | is(substr($a,1,1), 'b'); |
ec062429 |
677 | } |