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