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