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