This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Stop substr lvalues from being confused by changing UTF8ness
[perl5.git] / t / op / substr.t
CommitLineData
55b67815 1#!./perl
84902520
TB
2
3#P = start of string Q = start of substr R = end of substr S = end of string
a687059c 4
e476b1b5 5BEGIN {
3aa33fe5 6 chdir 't' if -d 't';
20822f61 7 @INC = '../lib';
e476b1b5
GS
8}
9use warnings ;
84902520 10
e476b1b5 11$a = 'abcdefxyz';
84902520
TB
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
GA
17 } elsif ($_[0] =~ /^Use of uninitialized value/) {
18 $w += 3;
84902520 19 } else {
5d82c453 20 warn $_[0];
84902520
TB
21 }
22};
a687059c 23
e27c778f 24BEGIN { require './test.pl'; }
e198f039 25
41b1a11c 26plan(381);
e476b1b5 27
e3faa678
NC
28run_tests() unless caller;
29
30my $krunch = "a";
31
32sub run_tests {
33
e198f039 34$FATAL_MSG = qr/^substr outside of string/;
84902520 35
e198f039
NC
36is(substr($a,0,3), 'abc'); # P=Q R S
37is(substr($a,3,3), 'def'); # P Q R S
38is(substr($a,6,999), 'xyz'); # P Q S R
e476b1b5 39$b = substr($a,999,999) ; # warn # P R Q S
e198f039 40is ($w--, 1);
e476b1b5 41eval{substr($a,999,999) = "" ; };# P R Q S
e198f039
NC
42like ($@, $FATAL_MSG);
43is(substr($a,0,-6), 'abc'); # P=Q R S
44is(substr($a,-3,1), 'x'); # P Q R S
f378d2d3
FC
45sub{$b = shift}->(substr($a,999,999));
46is ($w--, 1, 'boundless lvalue substr only warns on fetch');
a687059c 47
a687059c 48substr($a,3,3) = 'XYZ';
e198f039 49is($a, 'abcXYZxyz' );
a687059c 50substr($a,0,2) = '';
e198f039 51is($a, 'cXYZxyz' );
a687059c 52substr($a,0,0) = 'ab';
e198f039 53is($a, 'abcXYZxyz' );
a687059c 54substr($a,0,0) = '12345678';
e198f039 55is($a, '12345678abcXYZxyz' );
a687059c 56substr($a,-3,3) = 'def';
e198f039 57is($a, '12345678abcXYZdef');
a687059c 58substr($a,-3,3) = '<';
e198f039 59is($a, '12345678abcXYZ<' );
a687059c 60substr($a,-1,1) = '12345678';
e198f039 61is($a, '12345678abcXYZ12345678' );
a687059c 62
d9d8d8de
LW
63$a = 'abcdefxyz';
64
e198f039
NC
65is(substr($a,6), 'xyz' ); # P Q R=S
66is(substr($a,-3), 'xyz' ); # P Q R=S
e476b1b5 67$b = substr($a,999,999) ; # warning # P R=S Q
e198f039 68is($w--, 1);
e476b1b5 69eval{substr($a,999,999) = "" ; } ; # P R=S Q
e198f039
NC
70like($@, $FATAL_MSG);
71is(substr($a,0), 'abcdefxyz'); # P=Q R=S
72is(substr($a,9), ''); # P Q=R=S
73is(substr($a,-11), 'abcdefxyz'); # Q P R=S
74is(substr($a,-9), 'abcdefxyz'); # P=Q R=S
84902520
TB
75
76$a = '54321';
77
e476b1b5 78$b = substr($a,-7, 1) ; # warn # Q R P S
e198f039 79is($w--, 1);
e476b1b5 80eval{substr($a,-7, 1) = "" ; }; # Q R P S
e198f039 81like($@, $FATAL_MSG);
e476b1b5 82$b = substr($a,-7,-6) ; # warn # Q R P S
e198f039 83is($w--, 1);
e476b1b5 84eval{substr($a,-7,-6) = "" ; }; # Q R P S
e198f039
NC
85like($@, $FATAL_MSG);
86is(substr($a,-5,-7), ''); # R P=Q S
87is(substr($a, 2,-7), ''); # R P Q S
88is(substr($a,-3,-7), ''); # R P Q S
89is(substr($a, 2,-5), ''); # P=R Q S
90is(substr($a,-3,-5), ''); # P=R Q S
91is(substr($a, 2,-4), ''); # P R Q S
92is(substr($a,-3,-4), ''); # P R Q S
93is(substr($a, 5,-6), ''); # R P Q=S
94is(substr($a, 5,-5), ''); # P=R Q S
95is(substr($a, 5,-3), ''); # P R Q=S
e476b1b5 96$b = substr($a, 7,-7) ; # warn # R P S Q
e198f039 97is($w--, 1);
e476b1b5 98eval{substr($a, 7,-7) = "" ; }; # R P S Q
e198f039 99like($@, $FATAL_MSG);
e476b1b5 100$b = substr($a, 7,-5) ; # warn # P=R S Q
e198f039 101is($w--, 1);
e476b1b5 102eval{substr($a, 7,-5) = "" ; }; # P=R S Q
e198f039 103like($@, $FATAL_MSG);
e476b1b5 104$b = substr($a, 7,-3) ; # warn # P Q S Q
e198f039 105is($w--, 1);
e476b1b5 106eval{substr($a, 7,-3) = "" ; }; # P Q S Q
e198f039 107like($@, $FATAL_MSG);
e476b1b5 108$b = substr($a, 7, 0) ; # warn # P S Q=R
e198f039 109is($w--, 1);
e476b1b5 110eval{substr($a, 7, 0) = "" ; }; # P S Q=R
e198f039
NC
111like($@, $FATAL_MSG);
112
113is(substr($a,-7,2), ''); # Q P=R S
114is(substr($a,-7,4), '54'); # Q P R S
115is(substr($a,-7,7), '54321');# Q P R=S
116is(substr($a,-7,9), '54321');# Q P S R
117is(substr($a,-5,0), ''); # P=Q=R S
118is(substr($a,-5,3), '543');# P=Q R S
119is(substr($a,-5,5), '54321');# P=Q R=S
120is(substr($a,-5,7), '54321');# P=Q S R
121is(substr($a,-3,0), ''); # P Q=R S
122is(substr($a,-3,3), '321');# P Q R=S
123is(substr($a,-2,3), '21'); # P Q S R
124is(substr($a,0,-5), ''); # P=Q=R S
125is(substr($a,2,-3), ''); # P Q=R S
126is(substr($a,0,0), ''); # P=Q=R S
127is(substr($a,0,5), '54321');# P=Q R=S
128is(substr($a,0,7), '54321');# P=Q S R
129is(substr($a,2,0), ''); # P Q=R S
130is(substr($a,2,3), '321'); # P Q R=S
131is(substr($a,5,0), ''); # P Q=R=S
132is(substr($a,5,2), ''); # P Q=S R
133is(substr($a,-7,-5), ''); # Q P=R S
134is(substr($a,-7,-2), '543');# Q P R S
135is(substr($a,-5,-5), ''); # P=Q=R S
136is(substr($a,-5,-2), '543');# P=Q R S
137is(substr($a,-3,-3), ''); # P Q=R S
138is(substr($a,-3,-1), '32');# P Q R S
84902520
TB
139
140$a = '';
141
e198f039
NC
142is(substr($a,-2,2), ''); # Q P=R=S
143is(substr($a,0,0), ''); # P=Q=R=S
144is(substr($a,0,1), ''); # P=Q=S R
145is(substr($a,-2,3), ''); # Q P=S R
146is(substr($a,-2), ''); # Q P=R=S
147is(substr($a,0), ''); # P=Q=R=S
e476b1b5
GS
148
149
e198f039 150is(substr($a,0,-1), ''); # R P=Q=S
e476b1b5 151$b = substr($a,-2, 0) ; # warn # Q=R P=S
e198f039 152is($w--, 1);
e476b1b5 153eval{substr($a,-2, 0) = "" ; }; # Q=R P=S
e198f039 154like($@, $FATAL_MSG);
84902520 155
e476b1b5 156$b = substr($a,-2, 1) ; # warn # Q R P=S
e198f039 157is($w--, 1);
e476b1b5 158eval{substr($a,-2, 1) = "" ; }; # Q R P=S
e198f039 159like($@, $FATAL_MSG);
84902520 160
e476b1b5 161$b = substr($a,-2,-1) ; # warn # Q R P=S
e198f039 162is($w--, 1);
e476b1b5 163eval{substr($a,-2,-1) = "" ; }; # Q R P=S
e198f039 164like($@, $FATAL_MSG);
84902520 165
e476b1b5 166$b = substr($a,-2,-2) ; # warn # Q=R P=S
e198f039 167is($w--, 1);
e476b1b5 168eval{substr($a,-2,-2) = "" ; }; # Q=R P=S
e198f039 169like($@, $FATAL_MSG);
e476b1b5
GS
170
171$b = substr($a, 1,-2) ; # warn # R P=S Q
e198f039 172is($w--, 1);
e476b1b5 173eval{substr($a, 1,-2) = "" ; }; # R P=S Q
e198f039 174like($@, $FATAL_MSG);
e476b1b5
GS
175
176$b = substr($a, 1, 1) ; # warn # P=S Q R
e198f039 177is($w--, 1);
e476b1b5 178eval{substr($a, 1, 1) = "" ; }; # P=S Q R
e198f039 179like($@, $FATAL_MSG);
e476b1b5
GS
180
181$b = substr($a, 1, 0) ;# warn # P=S Q=R
e198f039 182is($w--, 1);
e476b1b5 183eval{substr($a, 1, 0) = "" ; }; # P=S Q=R
e198f039 184like($@, $FATAL_MSG);
e476b1b5
GS
185
186$b = substr($a,1) ; # warning # P=R=S Q
e198f039 187is($w--, 1);
e476b1b5 188eval{substr($a,1) = "" ; }; # P=R=S Q
e198f039 189like($@, $FATAL_MSG);
84902520 190
777f7c56
EB
191$b = substr($a,-7,-6) ; # warn # Q R P S
192is($w--, 1);
193eval{substr($a,-7,-6) = "" ; }; # Q R P S
194like($@, $FATAL_MSG);
195
84902520
TB
196my $a = 'zxcvbnm';
197substr($a,2,0) = '';
e198f039 198is($a, 'zxcvbnm');
84902520 199substr($a,7,0) = '';
e198f039 200is($a, 'zxcvbnm');
84902520 201substr($a,5,0) = '';
e198f039 202is($a, 'zxcvbnm');
84902520 203substr($a,0,2) = 'pq';
e198f039 204is($a, 'pqcvbnm');
84902520 205substr($a,2,0) = 'r';
e198f039 206is($a, 'pqrcvbnm');
84902520 207substr($a,8,0) = 'asd';
e198f039 208is($a, 'pqrcvbnmasd');
84902520 209substr($a,0,2) = 'iop';
e198f039 210is($a, 'ioprcvbnmasd');
84902520 211substr($a,0,5) = 'fgh';
e198f039 212is($a, 'fghvbnmasd');
84902520 213substr($a,3,5) = 'jkl';
e198f039 214is($a, 'fghjklsd');
84902520 215substr($a,3,2) = '1234';
e198f039 216is($a, 'fgh1234lsd');
84902520 217
08cb0b0d
PP
218
219# with lexicals (and in re-entered scopes)
220for (0,1) {
221 my $txt;
222 unless ($_) {
223 $txt = "Foo";
224 substr($txt, -1) = "X";
e198f039 225 is($txt, "FoX");
08cb0b0d
PP
226 }
227 else {
228 substr($txt, 0, 1) = "X";
e198f039 229 is($txt, "X");
08cb0b0d
PP
230 }
231}
232
e476b1b5 233$w = 0 ;
84902520 234# coercion of references
08cb0b0d
PP
235{
236 my $s = [];
237 substr($s, 0, 1) = 'Foo';
e198f039
NC
238 is (substr($s,0,7), "FooRRAY");
239 is ($w,2);
240 $w = 0;
08cb0b0d 241}
84902520
TB
242
243# check no spurious warnings
e198f039 244is($w, 0);
7b8d334a 245
5d82c453 246# check new 4 arg replacement syntax
7b8d334a 247$a = "abcxyz";
5d82c453 248$w = 0;
e198f039
NC
249is(substr($a, 0, 3, ""), "abc");
250is($a, "xyz");
251is(substr($a, 0, 0, "abc"), "");
252is($a, "abcxyz");
253is(substr($a, 3, -1, ""), "xy");
254is($a, "abcz");
e476b1b5 255
e198f039
NC
256is(substr($a, 3, undef, "xy"), "");
257is($a, "abcxyz");
258is($w, 3);
e476b1b5 259
5d82c453
GA
260$w = 0;
261
e198f039
NC
262is(substr($a, 3, 9999999, ""), "xyz");
263is($a, "abc");
e476b1b5 264eval{substr($a, -99, 0, "") };
e198f039 265like($@, $FATAL_MSG);
e476b1b5 266eval{substr($a, 99, 3, "") };
e198f039 267like($@, $FATAL_MSG);
5d82c453
GA
268
269substr($a, 0, length($a), "foo");
e198f039
NC
270is ($a, "foo");
271is ($w, 0);
5d82c453
GA
272
273# using 4 arg substr as lvalue is a compile time error
274eval 'substr($a,0,0,"") = "abc"';
e198f039
NC
275like ($@, qr/Can't modify substr/);
276is ($a, "foo");
c8faf1c5
GS
277
278$a = "abcdefgh";
e198f039
NC
279is(sub { shift }->(substr($a, 0, 4, "xxxx")), 'abcd');
280is($a, 'xxxxefgh');
7f66633b 281
e84ff256
GS
282{
283 my $y = 10;
284 $y = "2" . $y;
e198f039 285 is ($y, 210);
e84ff256
GS
286}
287
7f66633b
GS
288# utf8 sanity
289{
290 my $x = substr("a\x{263a}b",0);
e198f039 291 is(length($x), 3);
7f66633b 292 $x = substr($x,1,1);
e198f039 293 is($x, "\x{263a}");
dfcb284a 294 $x = $x x 2;
e198f039 295 is(length($x), 2);
7f66633b 296 substr($x,0,1) = "abcd";
e198f039
NC
297 is($x, "abcd\x{263a}");
298 is(length($x), 5);
e84ff256 299 $x = reverse $x;
e198f039
NC
300 is(length($x), 5);
301 is($x, "\x{263a}dcba");
e84ff256
GS
302
303 my $z = 10;
304 $z = "21\x{263a}" . $z;
e198f039
NC
305 is(length($z), 5);
306 is($z, "21\x{263a}10");
7f66633b 307}
35fba0d9
RG
308
309# replacement should work on magical values
310require Tie::Scalar;
311my %data;
312tie $data{'a'}, 'Tie::StdScalar'; # makes $data{'a'} magical
313$data{a} = "firstlast";
e198f039
NC
314is(substr($data{'a'}, 0, 5, ""), "first");
315is($data{'a'}, "last");
075a4a2b
JH
316
317# more utf8
318
319# The following two originally from Ignasi Roca.
320
321$x = "\xF1\xF2\xF3";
322substr($x, 0, 1) = "\x{100}"; # Ignasi had \x{FF}
e198f039
NC
323is(length($x), 3);
324is($x, "\x{100}\xF2\xF3");
325is(substr($x, 0, 1), "\x{100}");
326is(substr($x, 1, 1), "\x{F2}");
327is(substr($x, 2, 1), "\x{F3}");
075a4a2b
JH
328
329$x = "\xF1\xF2\xF3";
330substr($x, 0, 1) = "\x{100}\x{FF}"; # Ignasi had \x{FF}
e198f039
NC
331is(length($x), 4);
332is($x, "\x{100}\x{FF}\xF2\xF3");
333is(substr($x, 0, 1), "\x{100}");
334is(substr($x, 1, 1), "\x{FF}");
335is(substr($x, 2, 1), "\x{F2}");
336is(substr($x, 3, 1), "\x{F3}");
075a4a2b
JH
337
338# more utf8 lval exercise
339
340$x = "\xF1\xF2\xF3";
341substr($x, 0, 2) = "\x{100}\xFF";
e198f039
NC
342is(length($x), 3);
343is($x, "\x{100}\xFF\xF3");
344is(substr($x, 0, 1), "\x{100}");
345is(substr($x, 1, 1), "\x{FF}");
346is(substr($x, 2, 1), "\x{F3}");
075a4a2b
JH
347
348$x = "\xF1\xF2\xF3";
349substr($x, 1, 1) = "\x{100}\xFF";
e198f039
NC
350is(length($x), 4);
351is($x, "\xF1\x{100}\xFF\xF3");
352is(substr($x, 0, 1), "\x{F1}");
353is(substr($x, 1, 1), "\x{100}");
354is(substr($x, 2, 1), "\x{FF}");
355is(substr($x, 3, 1), "\x{F3}");
075a4a2b
JH
356
357$x = "\xF1\xF2\xF3";
358substr($x, 2, 1) = "\x{100}\xFF";
e198f039
NC
359is(length($x), 4);
360is($x, "\xF1\xF2\x{100}\xFF");
361is(substr($x, 0, 1), "\x{F1}");
362is(substr($x, 1, 1), "\x{F2}");
363is(substr($x, 2, 1), "\x{100}");
364is(substr($x, 3, 1), "\x{FF}");
075a4a2b
JH
365
366$x = "\xF1\xF2\xF3";
367substr($x, 3, 1) = "\x{100}\xFF";
e198f039
NC
368is(length($x), 5);
369is($x, "\xF1\xF2\xF3\x{100}\xFF");
370is(substr($x, 0, 1), "\x{F1}");
371is(substr($x, 1, 1), "\x{F2}");
372is(substr($x, 2, 1), "\x{F3}");
373is(substr($x, 3, 1), "\x{100}");
374is(substr($x, 4, 1), "\x{FF}");
075a4a2b
JH
375
376$x = "\xF1\xF2\xF3";
377substr($x, -1, 1) = "\x{100}\xFF";
e198f039
NC
378is(length($x), 4);
379is($x, "\xF1\xF2\x{100}\xFF");
380is(substr($x, 0, 1), "\x{F1}");
381is(substr($x, 1, 1), "\x{F2}");
382is(substr($x, 2, 1), "\x{100}");
383is(substr($x, 3, 1), "\x{FF}");
075a4a2b
JH
384
385$x = "\xF1\xF2\xF3";
386substr($x, -1, 0) = "\x{100}\xFF";
e198f039
NC
387is(length($x), 5);
388is($x, "\xF1\xF2\x{100}\xFF\xF3");
389is(substr($x, 0, 1), "\x{F1}");
390is(substr($x, 1, 1), "\x{F2}");
391is(substr($x, 2, 1), "\x{100}");
392is(substr($x, 3, 1), "\x{FF}");
393is(substr($x, 4, 1), "\x{F3}");
075a4a2b
JH
394
395$x = "\xF1\xF2\xF3";
396substr($x, 0, -1) = "\x{100}\xFF";
e198f039
NC
397is(length($x), 3);
398is($x, "\x{100}\xFF\xF3");
399is(substr($x, 0, 1), "\x{100}");
400is(substr($x, 1, 1), "\x{FF}");
401is(substr($x, 2, 1), "\x{F3}");
075a4a2b
JH
402
403$x = "\xF1\xF2\xF3";
404substr($x, 0, -2) = "\x{100}\xFF";
e198f039
NC
405is(length($x), 4);
406is($x, "\x{100}\xFF\xF2\xF3");
407is(substr($x, 0, 1), "\x{100}");
408is(substr($x, 1, 1), "\x{FF}");
409is(substr($x, 2, 1), "\x{F2}");
410is(substr($x, 3, 1), "\x{F3}");
075a4a2b
JH
411
412$x = "\xF1\xF2\xF3";
413substr($x, 0, -3) = "\x{100}\xFF";
e198f039
NC
414is(length($x), 5);
415is($x, "\x{100}\xFF\xF1\xF2\xF3");
416is(substr($x, 0, 1), "\x{100}");
417is(substr($x, 1, 1), "\x{FF}");
418is(substr($x, 2, 1), "\x{F1}");
419is(substr($x, 3, 1), "\x{F2}");
420is(substr($x, 4, 1), "\x{F3}");
075a4a2b
JH
421
422$x = "\xF1\xF2\xF3";
423substr($x, 1, -1) = "\x{100}\xFF";
e198f039
NC
424is(length($x), 4);
425is($x, "\xF1\x{100}\xFF\xF3");
426is(substr($x, 0, 1), "\x{F1}");
427is(substr($x, 1, 1), "\x{100}");
428is(substr($x, 2, 1), "\x{FF}");
429is(substr($x, 3, 1), "\x{F3}");
075a4a2b
JH
430
431$x = "\xF1\xF2\xF3";
432substr($x, -1, -1) = "\x{100}\xFF";
e198f039
NC
433is(length($x), 5);
434is($x, "\xF1\xF2\x{100}\xFF\xF3");
435is(substr($x, 0, 1), "\x{F1}");
436is(substr($x, 1, 1), "\x{F2}");
437is(substr($x, 2, 1), "\x{100}");
438is(substr($x, 3, 1), "\x{FF}");
439is(substr($x, 4, 1), "\x{F3}");
075a4a2b 440
9aa983d2
JH
441# And tests for already-UTF8 one
442
443$x = "\x{101}\x{F2}\x{F3}";
444substr($x, 0, 1) = "\x{100}";
e198f039
NC
445is(length($x), 3);
446is($x, "\x{100}\xF2\xF3");
447is(substr($x, 0, 1), "\x{100}");
448is(substr($x, 1, 1), "\x{F2}");
449is(substr($x, 2, 1), "\x{F3}");
9aa983d2
JH
450
451$x = "\x{101}\x{F2}\x{F3}";
452substr($x, 0, 1) = "\x{100}\x{FF}";
e198f039
NC
453is(length($x), 4);
454is($x, "\x{100}\x{FF}\xF2\xF3");
455is(substr($x, 0, 1), "\x{100}");
456is(substr($x, 1, 1), "\x{FF}");
457is(substr($x, 2, 1), "\x{F2}");
458is(substr($x, 3, 1), "\x{F3}");
9aa983d2
JH
459
460$x = "\x{101}\x{F2}\x{F3}";
461substr($x, 0, 2) = "\x{100}\xFF";
e198f039
NC
462is(length($x), 3);
463is($x, "\x{100}\xFF\xF3");
464is(substr($x, 0, 1), "\x{100}");
465is(substr($x, 1, 1), "\x{FF}");
466is(substr($x, 2, 1), "\x{F3}");
9aa983d2
JH
467
468$x = "\x{101}\x{F2}\x{F3}";
469substr($x, 1, 1) = "\x{100}\xFF";
e198f039
NC
470is(length($x), 4);
471is($x, "\x{101}\x{100}\xFF\xF3");
472is(substr($x, 0, 1), "\x{101}");
473is(substr($x, 1, 1), "\x{100}");
474is(substr($x, 2, 1), "\x{FF}");
475is(substr($x, 3, 1), "\x{F3}");
9aa983d2
JH
476
477$x = "\x{101}\x{F2}\x{F3}";
478substr($x, 2, 1) = "\x{100}\xFF";
e198f039
NC
479is(length($x), 4);
480is($x, "\x{101}\xF2\x{100}\xFF");
481is(substr($x, 0, 1), "\x{101}");
482is(substr($x, 1, 1), "\x{F2}");
483is(substr($x, 2, 1), "\x{100}");
484is(substr($x, 3, 1), "\x{FF}");
9aa983d2
JH
485
486$x = "\x{101}\x{F2}\x{F3}";
487substr($x, 3, 1) = "\x{100}\xFF";
e198f039
NC
488is(length($x), 5);
489is($x, "\x{101}\x{F2}\x{F3}\x{100}\xFF");
490is(substr($x, 0, 1), "\x{101}");
491is(substr($x, 1, 1), "\x{F2}");
492is(substr($x, 2, 1), "\x{F3}");
493is(substr($x, 3, 1), "\x{100}");
494is(substr($x, 4, 1), "\x{FF}");
9aa983d2
JH
495
496$x = "\x{101}\x{F2}\x{F3}";
497substr($x, -1, 1) = "\x{100}\xFF";
e198f039
NC
498is(length($x), 4);
499is($x, "\x{101}\xF2\x{100}\xFF");
500is(substr($x, 0, 1), "\x{101}");
501is(substr($x, 1, 1), "\x{F2}");
502is(substr($x, 2, 1), "\x{100}");
503is(substr($x, 3, 1), "\x{FF}");
9aa983d2
JH
504
505$x = "\x{101}\x{F2}\x{F3}";
506substr($x, -1, 0) = "\x{100}\xFF";
e198f039
NC
507is(length($x), 5);
508is($x, "\x{101}\xF2\x{100}\xFF\xF3");
509is(substr($x, 0, 1), "\x{101}");
510is(substr($x, 1, 1), "\x{F2}");
511is(substr($x, 2, 1), "\x{100}");
512is(substr($x, 3, 1), "\x{FF}");
513is(substr($x, 4, 1), "\x{F3}");
9aa983d2
JH
514
515$x = "\x{101}\x{F2}\x{F3}";
516substr($x, 0, -1) = "\x{100}\xFF";
e198f039
NC
517is(length($x), 3);
518is($x, "\x{100}\xFF\xF3");
519is(substr($x, 0, 1), "\x{100}");
520is(substr($x, 1, 1), "\x{FF}");
521is(substr($x, 2, 1), "\x{F3}");
9aa983d2
JH
522
523$x = "\x{101}\x{F2}\x{F3}";
524substr($x, 0, -2) = "\x{100}\xFF";
e198f039
NC
525is(length($x), 4);
526is($x, "\x{100}\xFF\xF2\xF3");
527is(substr($x, 0, 1), "\x{100}");
528is(substr($x, 1, 1), "\x{FF}");
529is(substr($x, 2, 1), "\x{F2}");
530is(substr($x, 3, 1), "\x{F3}");
9aa983d2
JH
531
532$x = "\x{101}\x{F2}\x{F3}";
533substr($x, 0, -3) = "\x{100}\xFF";
e198f039
NC
534is(length($x), 5);
535is($x, "\x{100}\xFF\x{101}\x{F2}\x{F3}");
536is(substr($x, 0, 1), "\x{100}");
537is(substr($x, 1, 1), "\x{FF}");
538is(substr($x, 2, 1), "\x{101}");
539is(substr($x, 3, 1), "\x{F2}");
540is(substr($x, 4, 1), "\x{F3}");
9aa983d2
JH
541
542$x = "\x{101}\x{F2}\x{F3}";
543substr($x, 1, -1) = "\x{100}\xFF";
e198f039
NC
544is(length($x), 4);
545is($x, "\x{101}\x{100}\xFF\xF3");
546is(substr($x, 0, 1), "\x{101}");
547is(substr($x, 1, 1), "\x{100}");
548is(substr($x, 2, 1), "\x{FF}");
549is(substr($x, 3, 1), "\x{F3}");
9aa983d2
JH
550
551$x = "\x{101}\x{F2}\x{F3}";
552substr($x, -1, -1) = "\x{100}\xFF";
e198f039
NC
553is(length($x), 5);
554is($x, "\x{101}\xF2\x{100}\xFF\xF3");
555is(substr($x, 0, 1), "\x{101}");
556is(substr($x, 1, 1), "\x{F2}");
557is(substr($x, 2, 1), "\x{100}");
558is(substr($x, 3, 1), "\x{FF}");
559is(substr($x, 4, 1), "\x{F3}");
f7928d6c
JH
560
561substr($x = "ab", 0, 0, "\x{100}\x{200}");
e198f039 562is($x, "\x{100}\x{200}ab");
f7928d6c
JH
563
564substr($x = "\x{100}\x{200}", 0, 0, "ab");
e198f039 565is($x, "ab\x{100}\x{200}");
f7928d6c
JH
566
567substr($x = "ab", 1, 0, "\x{100}\x{200}");
e198f039 568is($x, "a\x{100}\x{200}b");
f7928d6c
JH
569
570substr($x = "\x{100}\x{200}", 1, 0, "ab");
e198f039 571is($x, "\x{100}ab\x{200}");
f7928d6c
JH
572
573substr($x = "ab", 2, 0, "\x{100}\x{200}");
e198f039 574is($x, "ab\x{100}\x{200}");
f7928d6c
JH
575
576substr($x = "\x{100}\x{200}", 2, 0, "ab");
e198f039 577is($x, "\x{100}\x{200}ab");
f7928d6c 578
9402d6ed 579substr($x = "\xFFb", 0, 0, "\x{100}\x{200}");
e198f039 580is($x, "\x{100}\x{200}\xFFb");
9402d6ed
JH
581
582substr($x = "\x{100}\x{200}", 0, 0, "\xFFb");
e198f039 583is($x, "\xFFb\x{100}\x{200}");
9402d6ed
JH
584
585substr($x = "\xFFb", 1, 0, "\x{100}\x{200}");
e198f039 586is($x, "\xFF\x{100}\x{200}b");
9402d6ed
JH
587
588substr($x = "\x{100}\x{200}", 1, 0, "\xFFb");
e198f039 589is($x, "\x{100}\xFFb\x{200}");
9402d6ed
JH
590
591substr($x = "\xFFb", 2, 0, "\x{100}\x{200}");
e198f039 592is($x, "\xFFb\x{100}\x{200}");
9402d6ed
JH
593
594substr($x = "\x{100}\x{200}", 2, 0, "\xFFb");
e198f039 595is($x, "\x{100}\x{200}\xFFb");
9402d6ed 596
24aef97f
HS
597# [perl #20933]
598{
599 my $s = "ab";
600 my @r;
601 $r[$_] = \ substr $s, $_, 1 for (0, 1);
e198f039 602 is(join("", map { $$_ } @r), "ab");
24aef97f 603}
6214ab63
AE
604
605# [perl #23207]
606{
607 sub ss {
608 substr($_[0],0,1) ^= substr($_[0],1,1) ^=
609 substr($_[0],0,1) ^= substr($_[0],1,1);
610 }
611 my $x = my $y = 'AB'; ss $x; ss $y;
e198f039 612 is($x, $y);
6214ab63 613}
8f78557a
AE
614
615# [perl #24605]
616{
617 my $x = "0123456789\x{500}";
618 my $y = substr $x, 4;
e198f039 619 is(substr($x, 7, 1), "7");
8f78557a 620}
c2552146
DM
621
622# multiple assignments to lvalue [perl #24346]
623{
624 my $x = "abcdef";
625 for (substr($x,1,3)) {
e198f039 626 is($_, 'bcd');
c2552146 627 $_ = 'XX';
e198f039
NC
628 is($_, 'XX');
629 is($x, 'aXXef');
c2552146 630 $_ = "\xFF";
e198f039
NC
631 is($_, "\xFF");
632 is($x, "a\xFFef");
c2552146 633 $_ = "\xF1\xF2\xF3\xF4\xF5\xF6";
e198f039
NC
634 is($_, "\xF1\xF2\xF3\xF4\xF5\xF6");
635 is($x, "a\xF1\xF2\xF3\xF4\xF5\xF6ef");
c2552146 636 $_ = 'YYYY';
e198f039
NC
637 is($_, 'YYYY');
638 is($x, 'aYYYYef');
c2552146 639 }
83f78d1a
FC
640 $x = "abcdef";
641 for (substr($x,1)) {
642 is($_, 'bcdef');
643 $_ = 'XX';
644 is($_, 'XX');
645 is($x, 'aXX');
646 $x .= "frompswiggle";
647 is $_, "XXfrompswiggle";
648 }
649 $x = "abcdef";
650 for (substr($x,1,-1)) {
651 is($_, 'bcde');
652 $_ = 'XX';
653 is($_, 'XX');
654 is($x, 'aXXf');
655 $x .= "frompswiggle";
656 is $_, "XXffrompswiggl";
657 }
658 $x = "abcdef";
659 for (substr($x,-5,3)) {
660 is($_, 'bcd');
661 $_ = 'XX'; # now $_ is substr($x, -4, 2)
662 is($_, 'XX');
663 is($x, 'aXXef');
664 $x .= "frompswiggle";
665 is $_, "gg";
666 }
667 $x = "abcdef";
668 for (substr($x,-5)) {
669 is($_, 'bcdef');
670 $_ = 'XX'; # now substr($x, -2)
671 is($_, 'XX');
672 is($x, 'aXX');
673 $x .= "frompswiggle";
674 is $_, "le";
675 }
676 $x = "abcdef";
677 for (substr($x,-5,-1)) {
678 is($_, 'bcde');
679 $_ = 'XX'; # now substr($x, -3, -1)
680 is($_, 'XX');
681 is($x, 'aXXf');
682 $x .= "frompswiggle";
683 is $_, "gl";
684 }
c2552146 685}
781e7547
DM
686
687# [perl #24200] string corruption with lvalue sub
688
689{
e3faa678 690 sub bar: lvalue { substr $krunch, 0 }
781e7547 691 bar = "XXX";
e198f039 692 is(bar, 'XXX');
e3faa678 693 $krunch = '123456789';
e198f039 694 is(bar, '123456789');
781e7547 695}
a67d7df9
ST
696
697# [perl #29149]
698{
699 my $text = "0123456789\xED ";
700 utf8::upgrade($text);
701 my $pos = 5;
702 pos($text) = $pos;
703 my $a = substr($text, $pos, $pos);
e198f039 704 is(substr($text,$pos,1), $pos);
a67d7df9
ST
705
706}
080534f4
RGS
707
708# [perl #23765]
709{
710 my $a = pack("C", 0xbf);
711 substr($a, -1) &= chr(0xfeff);
e198f039 712 is($a, "\xbf");
080534f4 713}
ec062429
DM
714
715# [perl #34976] incorrect caching of utf8 substr length
716{
717 my $a = "abcd\x{100}";
e198f039
NC
718 is(substr($a,1,2), 'bc');
719 is(substr($a,1,1), 'b');
ec062429 720}
e3faa678 721
777f7c56
EB
722# [perl #62646] offsets exceeding 32 bits on 64-bit system
723SKIP: {
724 skip("32-bit system", 24) unless ~0 > 0xffffffff;
725 my $a = "abc";
726 my $s;
727 my $r;
728
729 utf8::downgrade($a);
730 for (1..2) {
731 $w = 0;
732 $r = substr($a, 0xffffffff, 1);
733 is($r, undef);
734 is($w, 1);
735
736 $w = 0;
737 $r = substr($a, 0xffffffff+1, 1);
738 is($r, undef);
739 is($w, 1);
740
741 $w = 0;
742 ok( !eval { $r = substr($s=$a, 0xffffffff, 1, "_"); 1 } );
743 is($r, undef);
744 is($s, $a);
745 is($w, 0);
746
747 $w = 0;
748 ok( !eval { $r = substr($s=$a, 0xffffffff+1, 1, "_"); 1 } );
749 is($r, undef);
750 is($s, $a);
751 is($w, 0);
752
753 utf8::upgrade($a);
754 }
755}
756
e27c778f
FC
757# [perl #77692] UTF8 cache not being reset when TARG is reused
758ok eval {
759 local ${^UTF8CACHE} = -1;
760 for my $i (0..1)
761 {
762 my $dummy = length(substr("\x{100}",0,$i));
763 }
764 1
765}, 'UTF8 cache is reset when TARG is reused [perl #77692]';
23037b03
FC
766
767{
bf32a30c
BF
768 use utf8;
769 use open qw( :utf8 :std );
770 no warnings 'once';
771
772 my $t = "";
773 substr $t, 0, 0, *ワルド;
774 is($t, "*main::ワルド", "substr works on UTF-8 globs");
775
776 $t = "The World!";
777 substr $t, 0, 9, *ザ::ワルド;
778 is($t, "*ザ::ワルド!", "substr works on a UTF-8 glob + stash");
779}
a74fb2cd
FC
780
781{
782 my $x = *foo;
783 my $y = \substr *foo, 0, 0;
784 is ref \$x, 'GLOB', '\substr does not coerce its glob arg just yet';
785 $x = \"foo";
786 $y = \substr *foo, 0, 0;
787 is ref \$x, 'REF', '\substr does not coerce its ref arg just yet';
788}
2956677f
FC
789
790} # sub run_tests - put tests above this line that can run in threads
791
792
793my $destroyed;
794{ package Class; DESTROY { ++$destroyed; } }
795
796$destroyed = 0;
797{
798 my $x = '';
799 substr($x,0,1) = "";
800 $x = bless({}, 'Class');
801}
802is($destroyed, 1, 'Timely scalar destruction with lvalue substr');
803
804{
805 my $result_3363;
806 sub a_3363 {
807 my ($word, $replace) = @_;
808 my $ref = \substr($word, 0, 1);
809 $$ref = $replace;
810 if ($replace eq "b") {
811 $result_3363 = $word;
812 } else {
813 a_3363($word, "b");
814 }
815 }
816 a_3363($_, "v") for "test";
817
818 is($result_3363, "best", "ref-to-substr retains lvalue-ness under recursion [perl #3363]");
819}