projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Restore strict refs on stashes, removed by ce10b5d1ec5b5f68b0811018a415bc37.
[p5sagit/p5-mst-13.2.git] / t / re / substr.t
CommitLineData
55b67815 1#!./perl
84902520 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 8}
9use warnings ;
55b67815 10no warnings 'deprecated';
84902520 11
e476b1b5 12$a = 'abcdefxyz';
84902520 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 18 } elsif ($_[0] =~ /^Use of uninitialized value/) {
19 $w += 3;
84902520 20 } else {
5d82c453 21 warn $_[0];
84902520 22 }
23};
a687059c 24
e198f039 25require './test.pl';
26
777f7c56 27plan(360);
e476b1b5 28
e3faa678 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 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 43like ($@, $FATAL_MSG);
44is(substr($a,0,-6), 'abc'); # P=Q R S
45is(substr($a,-3,1), 'x'); # P Q R S
a687059c 46
47$[ = 1;
48
e198f039 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 55like ($@, $FATAL_MSG);
56is(substr($a,1,-6), 'abc' );# P=Q R S
57is(substr($a,-3,1), 'x' ); # P Q R S
a687059c 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 76$a = 'abcdefxyz';
77
e198f039 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 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 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 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 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 152
153$a = '';
154
e198f039 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 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 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 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 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 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 203
777f7c56 204$b = substr($a,-7,-6) ; # warn # Q R P S
205is($w--, 1);
206eval{substr($a,-7,-6) = "" ; }; # Q R P S
207like($@, $FATAL_MSG);
208
84902520 209my $a = 'zxcvbnm';
210substr($a,2,0) = '';
e198f039 211is($a, 'zxcvbnm');
84902520 212substr($a,7,0) = '';
e198f039 213is($a, 'zxcvbnm');
84902520 214substr($a,5,0) = '';
e198f039 215is($a, 'zxcvbnm');
84902520 216substr($a,0,2) = 'pq';
e198f039 217is($a, 'pqcvbnm');
84902520 218substr($a,2,0) = 'r';
e198f039 219is($a, 'pqrcvbnm');
84902520 220substr($a,8,0) = 'asd';
e198f039 221is($a, 'pqrcvbnmasd');
84902520 222substr($a,0,2) = 'iop';
e198f039 223is($a, 'ioprcvbnmasd');
84902520 224substr($a,0,5) = 'fgh';
e198f039 225is($a, 'fghvbnmasd');
84902520 226substr($a,3,5) = 'jkl';
e198f039 227is($a, 'fghjklsd');
84902520 228substr($a,3,2) = '1234';
e198f039 229is($a, 'fgh1234lsd');
84902520 230
08cb0b0d 231
232# with lexicals (and in re-entered scopes)
233for (0,1) {
234 my $txt;
235 unless ($_) {
236 $txt = "Foo";
237 substr($txt, -1) = "X";
e198f039 238 is($txt, "FoX");
08cb0b0d 239 }
240 else {
241 substr($txt, 0, 1) = "X";
e198f039 242 is($txt, "X");
08cb0b0d 243 }
244}
245
e476b1b5 246$w = 0 ;
84902520 247# coercion of references
08cb0b0d 248{
249 my $s = [];
250 substr($s, 0, 1) = 'Foo';
e198f039 251 is (substr($s,0,7), "FooRRAY");
252 is ($w,2);
253 $w = 0;
08cb0b0d 254}
84902520 255
256# check no spurious warnings
e198f039 257is($w, 0);
7b8d334a 258
5d82c453 259# check new 4 arg replacement syntax
7b8d334a 260$a = "abcxyz";
5d82c453 261$w = 0;
e198f039 262is(substr($a, 0, 3, ""), "abc");
263is($a, "xyz");
264is(substr($a, 0, 0, "abc"), "");
265is($a, "abcxyz");
266is(substr($a, 3, -1, ""), "xy");
267is($a, "abcz");
e476b1b5 268
e198f039 269is(substr($a, 3, undef, "xy"), "");
270is($a, "abcxyz");
271is($w, 3);
e476b1b5 272
5d82c453 273$w = 0;
274
e198f039 275is(substr($a, 3, 9999999, ""), "xyz");
276is($a, "abc");
e476b1b5 277eval{substr($a, -99, 0, "") };
e198f039 278like($@, $FATAL_MSG);
e476b1b5 279eval{substr($a, 99, 3, "") };
e198f039 280like($@, $FATAL_MSG);
5d82c453 281
282substr($a, 0, length($a), "foo");
e198f039 283is ($a, "foo");
284is ($w, 0);
5d82c453 285
286# using 4 arg substr as lvalue is a compile time error
287eval 'substr($a,0,0,"") = "abc"';
e198f039 288like ($@, qr/Can't modify substr/);
289is ($a, "foo");
c8faf1c5 290
291$a = "abcdefgh";
e198f039 292is(sub { shift }->(substr($a, 0, 4, "xxxx")), 'abcd');
293is($a, 'xxxxefgh');
7f66633b 294
e84ff256 295{
296 my $y = 10;
297 $y = "2" . $y;
e198f039 298 is ($y, 210);
e84ff256 299}
300
7f66633b 301# utf8 sanity
302{
303 my $x = substr("a\x{263a}b",0);
e198f039 304 is(length($x), 3);
7f66633b 305 $x = substr($x,1,1);
e198f039 306 is($x, "\x{263a}");
dfcb284a 307 $x = $x x 2;
e198f039 308 is(length($x), 2);
7f66633b 309 substr($x,0,1) = "abcd";
e198f039 310 is($x, "abcd\x{263a}");
311 is(length($x), 5);
e84ff256 312 $x = reverse $x;
e198f039 313 is(length($x), 5);
314 is($x, "\x{263a}dcba");
e84ff256 315
316 my $z = 10;
317 $z = "21\x{263a}" . $z;
e198f039 318 is(length($z), 5);
319 is($z, "21\x{263a}10");
7f66633b 320}
35fba0d9 321
322# replacement should work on magical values
323require Tie::Scalar;
324my %data;
325tie $data{'a'}, 'Tie::StdScalar'; # makes $data{'a'} magical
326$data{a} = "firstlast";
e198f039 327is(substr($data{'a'}, 0, 5, ""), "first");
328is($data{'a'}, "last");
075a4a2b 329
330# more utf8
331
332# The following two originally from Ignasi Roca.
333
334$x = "\xF1\xF2\xF3";
335substr($x, 0, 1) = "\x{100}"; # Ignasi had \x{FF}
e198f039 336is(length($x), 3);
337is($x, "\x{100}\xF2\xF3");
338is(substr($x, 0, 1), "\x{100}");
339is(substr($x, 1, 1), "\x{F2}");
340is(substr($x, 2, 1), "\x{F3}");
075a4a2b 341
342$x = "\xF1\xF2\xF3";
343substr($x, 0, 1) = "\x{100}\x{FF}"; # Ignasi had \x{FF}
e198f039 344is(length($x), 4);
345is($x, "\x{100}\x{FF}\xF2\xF3");
346is(substr($x, 0, 1), "\x{100}");
347is(substr($x, 1, 1), "\x{FF}");
348is(substr($x, 2, 1), "\x{F2}");
349is(substr($x, 3, 1), "\x{F3}");
075a4a2b 350
351# more utf8 lval exercise
352
353$x = "\xF1\xF2\xF3";
354substr($x, 0, 2) = "\x{100}\xFF";
e198f039 355is(length($x), 3);
356is($x, "\x{100}\xFF\xF3");
357is(substr($x, 0, 1), "\x{100}");
358is(substr($x, 1, 1), "\x{FF}");
359is(substr($x, 2, 1), "\x{F3}");
075a4a2b 360
361$x = "\xF1\xF2\xF3";
362substr($x, 1, 1) = "\x{100}\xFF";
e198f039 363is(length($x), 4);
364is($x, "\xF1\x{100}\xFF\xF3");
365is(substr($x, 0, 1), "\x{F1}");
366is(substr($x, 1, 1), "\x{100}");
367is(substr($x, 2, 1), "\x{FF}");
368is(substr($x, 3, 1), "\x{F3}");
075a4a2b 369
370$x = "\xF1\xF2\xF3";
371substr($x, 2, 1) = "\x{100}\xFF";
e198f039 372is(length($x), 4);
373is($x, "\xF1\xF2\x{100}\xFF");
374is(substr($x, 0, 1), "\x{F1}");
375is(substr($x, 1, 1), "\x{F2}");
376is(substr($x, 2, 1), "\x{100}");
377is(substr($x, 3, 1), "\x{FF}");
075a4a2b 378
379$x = "\xF1\xF2\xF3";
380substr($x, 3, 1) = "\x{100}\xFF";
e198f039 381is(length($x), 5);
382is($x, "\xF1\xF2\xF3\x{100}\xFF");
383is(substr($x, 0, 1), "\x{F1}");
384is(substr($x, 1, 1), "\x{F2}");
385is(substr($x, 2, 1), "\x{F3}");
386is(substr($x, 3, 1), "\x{100}");
387is(substr($x, 4, 1), "\x{FF}");
075a4a2b 388
389$x = "\xF1\xF2\xF3";
390substr($x, -1, 1) = "\x{100}\xFF";
e198f039 391is(length($x), 4);
392is($x, "\xF1\xF2\x{100}\xFF");
393is(substr($x, 0, 1), "\x{F1}");
394is(substr($x, 1, 1), "\x{F2}");
395is(substr($x, 2, 1), "\x{100}");
396is(substr($x, 3, 1), "\x{FF}");
075a4a2b 397
398$x = "\xF1\xF2\xF3";
399substr($x, -1, 0) = "\x{100}\xFF";
e198f039 400is(length($x), 5);
401is($x, "\xF1\xF2\x{100}\xFF\xF3");
402is(substr($x, 0, 1), "\x{F1}");
403is(substr($x, 1, 1), "\x{F2}");
404is(substr($x, 2, 1), "\x{100}");
405is(substr($x, 3, 1), "\x{FF}");
406is(substr($x, 4, 1), "\x{F3}");
075a4a2b 407
408$x = "\xF1\xF2\xF3";
409substr($x, 0, -1) = "\x{100}\xFF";
e198f039 410is(length($x), 3);
411is($x, "\x{100}\xFF\xF3");
412is(substr($x, 0, 1), "\x{100}");
413is(substr($x, 1, 1), "\x{FF}");
414is(substr($x, 2, 1), "\x{F3}");
075a4a2b 415
416$x = "\xF1\xF2\xF3";
417substr($x, 0, -2) = "\x{100}\xFF";
e198f039 418is(length($x), 4);
419is($x, "\x{100}\xFF\xF2\xF3");
420is(substr($x, 0, 1), "\x{100}");
421is(substr($x, 1, 1), "\x{FF}");
422is(substr($x, 2, 1), "\x{F2}");
423is(substr($x, 3, 1), "\x{F3}");
075a4a2b 424
425$x = "\xF1\xF2\xF3";
426substr($x, 0, -3) = "\x{100}\xFF";
e198f039 427is(length($x), 5);
428is($x, "\x{100}\xFF\xF1\xF2\xF3");
429is(substr($x, 0, 1), "\x{100}");
430is(substr($x, 1, 1), "\x{FF}");
431is(substr($x, 2, 1), "\x{F1}");
432is(substr($x, 3, 1), "\x{F2}");
433is(substr($x, 4, 1), "\x{F3}");
075a4a2b 434
435$x = "\xF1\xF2\xF3";
436substr($x, 1, -1) = "\x{100}\xFF";
e198f039 437is(length($x), 4);
438is($x, "\xF1\x{100}\xFF\xF3");
439is(substr($x, 0, 1), "\x{F1}");
440is(substr($x, 1, 1), "\x{100}");
441is(substr($x, 2, 1), "\x{FF}");
442is(substr($x, 3, 1), "\x{F3}");
075a4a2b 443
444$x = "\xF1\xF2\xF3";
445substr($x, -1, -1) = "\x{100}\xFF";
e198f039 446is(length($x), 5);
447is($x, "\xF1\xF2\x{100}\xFF\xF3");
448is(substr($x, 0, 1), "\x{F1}");
449is(substr($x, 1, 1), "\x{F2}");
450is(substr($x, 2, 1), "\x{100}");
451is(substr($x, 3, 1), "\x{FF}");
452is(substr($x, 4, 1), "\x{F3}");
075a4a2b 453
9aa983d2 454# And tests for already-UTF8 one
455
456$x = "\x{101}\x{F2}\x{F3}";
457substr($x, 0, 1) = "\x{100}";
e198f039 458is(length($x), 3);
459is($x, "\x{100}\xF2\xF3");
460is(substr($x, 0, 1), "\x{100}");
461is(substr($x, 1, 1), "\x{F2}");
462is(substr($x, 2, 1), "\x{F3}");
9aa983d2 463
464$x = "\x{101}\x{F2}\x{F3}";
465substr($x, 0, 1) = "\x{100}\x{FF}";
e198f039 466is(length($x), 4);
467is($x, "\x{100}\x{FF}\xF2\xF3");
468is(substr($x, 0, 1), "\x{100}");
469is(substr($x, 1, 1), "\x{FF}");
470is(substr($x, 2, 1), "\x{F2}");
471is(substr($x, 3, 1), "\x{F3}");
9aa983d2 472
473$x = "\x{101}\x{F2}\x{F3}";
474substr($x, 0, 2) = "\x{100}\xFF";
e198f039 475is(length($x), 3);
476is($x, "\x{100}\xFF\xF3");
477is(substr($x, 0, 1), "\x{100}");
478is(substr($x, 1, 1), "\x{FF}");
479is(substr($x, 2, 1), "\x{F3}");
9aa983d2 480
481$x = "\x{101}\x{F2}\x{F3}";
482substr($x, 1, 1) = "\x{100}\xFF";
e198f039 483is(length($x), 4);
484is($x, "\x{101}\x{100}\xFF\xF3");
485is(substr($x, 0, 1), "\x{101}");
486is(substr($x, 1, 1), "\x{100}");
487is(substr($x, 2, 1), "\x{FF}");
488is(substr($x, 3, 1), "\x{F3}");
9aa983d2 489
490$x = "\x{101}\x{F2}\x{F3}";
491substr($x, 2, 1) = "\x{100}\xFF";
e198f039 492is(length($x), 4);
493is($x, "\x{101}\xF2\x{100}\xFF");
494is(substr($x, 0, 1), "\x{101}");
495is(substr($x, 1, 1), "\x{F2}");
496is(substr($x, 2, 1), "\x{100}");
497is(substr($x, 3, 1), "\x{FF}");
9aa983d2 498
499$x = "\x{101}\x{F2}\x{F3}";
500substr($x, 3, 1) = "\x{100}\xFF";
e198f039 501is(length($x), 5);
502is($x, "\x{101}\x{F2}\x{F3}\x{100}\xFF");
503is(substr($x, 0, 1), "\x{101}");
504is(substr($x, 1, 1), "\x{F2}");
505is(substr($x, 2, 1), "\x{F3}");
506is(substr($x, 3, 1), "\x{100}");
507is(substr($x, 4, 1), "\x{FF}");
9aa983d2 508
509$x = "\x{101}\x{F2}\x{F3}";
510substr($x, -1, 1) = "\x{100}\xFF";
e198f039 511is(length($x), 4);
512is($x, "\x{101}\xF2\x{100}\xFF");
513is(substr($x, 0, 1), "\x{101}");
514is(substr($x, 1, 1), "\x{F2}");
515is(substr($x, 2, 1), "\x{100}");
516is(substr($x, 3, 1), "\x{FF}");
9aa983d2 517
518$x = "\x{101}\x{F2}\x{F3}";
519substr($x, -1, 0) = "\x{100}\xFF";
e198f039 520is(length($x), 5);
521is($x, "\x{101}\xF2\x{100}\xFF\xF3");
522is(substr($x, 0, 1), "\x{101}");
523is(substr($x, 1, 1), "\x{F2}");
524is(substr($x, 2, 1), "\x{100}");
525is(substr($x, 3, 1), "\x{FF}");
526is(substr($x, 4, 1), "\x{F3}");
9aa983d2 527
528$x = "\x{101}\x{F2}\x{F3}";
529substr($x, 0, -1) = "\x{100}\xFF";
e198f039 530is(length($x), 3);
531is($x, "\x{100}\xFF\xF3");
532is(substr($x, 0, 1), "\x{100}");
533is(substr($x, 1, 1), "\x{FF}");
534is(substr($x, 2, 1), "\x{F3}");
9aa983d2 535
536$x = "\x{101}\x{F2}\x{F3}";
537substr($x, 0, -2) = "\x{100}\xFF";
e198f039 538is(length($x), 4);
539is($x, "\x{100}\xFF\xF2\xF3");
540is(substr($x, 0, 1), "\x{100}");
541is(substr($x, 1, 1), "\x{FF}");
542is(substr($x, 2, 1), "\x{F2}");
543is(substr($x, 3, 1), "\x{F3}");
9aa983d2 544
545$x = "\x{101}\x{F2}\x{F3}";
546substr($x, 0, -3) = "\x{100}\xFF";
e198f039 547is(length($x), 5);
548is($x, "\x{100}\xFF\x{101}\x{F2}\x{F3}");
549is(substr($x, 0, 1), "\x{100}");
550is(substr($x, 1, 1), "\x{FF}");
551is(substr($x, 2, 1), "\x{101}");
552is(substr($x, 3, 1), "\x{F2}");
553is(substr($x, 4, 1), "\x{F3}");
9aa983d2 554
555$x = "\x{101}\x{F2}\x{F3}";
556substr($x, 1, -1) = "\x{100}\xFF";
e198f039 557is(length($x), 4);
558is($x, "\x{101}\x{100}\xFF\xF3");
559is(substr($x, 0, 1), "\x{101}");
560is(substr($x, 1, 1), "\x{100}");
561is(substr($x, 2, 1), "\x{FF}");
562is(substr($x, 3, 1), "\x{F3}");
9aa983d2 563
564$x = "\x{101}\x{F2}\x{F3}";
565substr($x, -1, -1) = "\x{100}\xFF";
e198f039 566is(length($x), 5);
567is($x, "\x{101}\xF2\x{100}\xFF\xF3");
568is(substr($x, 0, 1), "\x{101}");
569is(substr($x, 1, 1), "\x{F2}");
570is(substr($x, 2, 1), "\x{100}");
571is(substr($x, 3, 1), "\x{FF}");
572is(substr($x, 4, 1), "\x{F3}");
f7928d6c 573
574substr($x = "ab", 0, 0, "\x{100}\x{200}");
e198f039 575is($x, "\x{100}\x{200}ab");
f7928d6c 576
577substr($x = "\x{100}\x{200}", 0, 0, "ab");
e198f039 578is($x, "ab\x{100}\x{200}");
f7928d6c 579
580substr($x = "ab", 1, 0, "\x{100}\x{200}");
e198f039 581is($x, "a\x{100}\x{200}b");
f7928d6c 582
583substr($x = "\x{100}\x{200}", 1, 0, "ab");
e198f039 584is($x, "\x{100}ab\x{200}");
f7928d6c 585
586substr($x = "ab", 2, 0, "\x{100}\x{200}");
e198f039 587is($x, "ab\x{100}\x{200}");
f7928d6c 588
589substr($x = "\x{100}\x{200}", 2, 0, "ab");
e198f039 590is($x, "\x{100}\x{200}ab");
f7928d6c 591
9402d6ed 592substr($x = "\xFFb", 0, 0, "\x{100}\x{200}");
e198f039 593is($x, "\x{100}\x{200}\xFFb");
9402d6ed 594
595substr($x = "\x{100}\x{200}", 0, 0, "\xFFb");
e198f039 596is($x, "\xFFb\x{100}\x{200}");
9402d6ed 597
598substr($x = "\xFFb", 1, 0, "\x{100}\x{200}");
e198f039 599is($x, "\xFF\x{100}\x{200}b");
9402d6ed 600
601substr($x = "\x{100}\x{200}", 1, 0, "\xFFb");
e198f039 602is($x, "\x{100}\xFFb\x{200}");
9402d6ed 603
604substr($x = "\xFFb", 2, 0, "\x{100}\x{200}");
e198f039 605is($x, "\xFFb\x{100}\x{200}");
9402d6ed 606
607substr($x = "\x{100}\x{200}", 2, 0, "\xFFb");
e198f039 608is($x, "\x{100}\x{200}\xFFb");
9402d6ed 609
24aef97f 610# [perl #20933]
611{
612 my $s = "ab";
613 my @r;
614 $r[$_] = \ substr $s, $_, 1 for (0, 1);
e198f039 615 is(join("", map { $$_ } @r), "ab");
24aef97f 616}
6214ab63 617
618# [perl #23207]
619{
620 sub ss {
621 substr($_[0],0,1) ^= substr($_[0],1,1) ^=
622 substr($_[0],0,1) ^= substr($_[0],1,1);
623 }
624 my $x = my $y = 'AB'; ss $x; ss $y;
e198f039 625 is($x, $y);
6214ab63 626}
8f78557a 627
628# [perl #24605]
629{
630 my $x = "0123456789\x{500}";
631 my $y = substr $x, 4;
e198f039 632 is(substr($x, 7, 1), "7");
8f78557a 633}
c2552146 634
635# multiple assignments to lvalue [perl #24346]
636{
637 my $x = "abcdef";
638 for (substr($x,1,3)) {
e198f039 639 is($_, 'bcd');
c2552146 640 $_ = 'XX';
e198f039 641 is($_, 'XX');
642 is($x, 'aXXef');
c2552146 643 $_ = "\xFF";
e198f039 644 is($_, "\xFF");
645 is($x, "a\xFFef");
c2552146 646 $_ = "\xF1\xF2\xF3\xF4\xF5\xF6";
e198f039 647 is($_, "\xF1\xF2\xF3\xF4\xF5\xF6");
648 is($x, "a\xF1\xF2\xF3\xF4\xF5\xF6ef");
c2552146 649 $_ = 'YYYY';
e198f039 650 is($_, 'YYYY');
651 is($x, 'aYYYYef');
c2552146 652 }
653}
781e7547 654
655# [perl #24200] string corruption with lvalue sub
656
657{
e3faa678 658 sub bar: lvalue { substr $krunch, 0 }
781e7547 659 bar = "XXX";
e198f039 660 is(bar, 'XXX');
e3faa678 661 $krunch = '123456789';
e198f039 662 is(bar, '123456789');
781e7547 663}
a67d7df9 664
665# [perl #29149]
666{
667 my $text = "0123456789\xED ";
668 utf8::upgrade($text);
669 my $pos = 5;
670 pos($text) = $pos;
671 my $a = substr($text, $pos, $pos);
e198f039 672 is(substr($text,$pos,1), $pos);
a67d7df9 673
674}
080534f4 675
676# [perl #23765]
677{
678 my $a = pack("C", 0xbf);
679 substr($a, -1) &= chr(0xfeff);
e198f039 680 is($a, "\xbf");
080534f4 681}
ec062429 682
683# [perl #34976] incorrect caching of utf8 substr length
684{
685 my $a = "abcd\x{100}";
e198f039 686 is(substr($a,1,2), 'bc');
687 is(substr($a,1,1), 'b');
ec062429 688}
e3faa678 689
777f7c56 690# [perl #62646] offsets exceeding 32 bits on 64-bit system
691SKIP: {
692 skip("32-bit system", 24) unless ~0 > 0xffffffff;
693 my $a = "abc";
694 my $s;
695 my $r;
696
697 utf8::downgrade($a);
698 for (1..2) {
699 $w = 0;
700 $r = substr($a, 0xffffffff, 1);
701 is($r, undef);
702 is($w, 1);
703
704 $w = 0;
705 $r = substr($a, 0xffffffff+1, 1);
706 is($r, undef);
707 is($w, 1);
708
709 $w = 0;
710 ok( !eval { $r = substr($s=$a, 0xffffffff, 1, "_"); 1 } );
711 is($r, undef);
712 is($s, $a);
713 is($w, 0);
714
715 $w = 0;
716 ok( !eval { $r = substr($s=$a, 0xffffffff+1, 1, "_"); 1 } );
717 is($r, undef);
718 is($s, $a);
719 is($w, 0);
720
721 utf8::upgrade($a);
722 }
723}
724
e3faa678 725}
Unnamed repository; edit this file to name it for gitweb.