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