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