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