3 #P = start of string Q = start of substr R = end of substr S = end of string
12 $SIG{__WARN__} = sub {
13 if ($_[0] =~ /^substr outside of string/) {
15 } elsif ($_[0] =~ /^Attempt to use reference as lvalue in substr/) {
17 } elsif ($_[0] =~ /^Use of uninitialized value/) {
28 run_tests() unless caller;
34 $FATAL_MSG = qr/^substr outside of string/;
36 is(substr($a,0,3), 'abc'); # P=Q R S
37 is(substr($a,3,3), 'def'); # P Q R S
38 is(substr($a,6,999), 'xyz'); # P Q S R
39 $b = substr($a,999,999) ; # warn # P R Q S
41 eval{substr($a,999,999) = "" ; };# P R Q S
42 like ($@, $FATAL_MSG);
43 is(substr($a,0,-6), 'abc'); # P=Q R S
44 is(substr($a,-3,1), 'x'); # P Q R S
48 is(substr($a,1,3), 'abc' ); # P=Q R S
49 is(substr($a,4,3), 'def' ); # P Q R S
50 is(substr($a,7,999), 'xyz');# P Q S R
51 $b = substr($a,999,999) ; # warn # P R Q S
53 eval{substr($a,999,999) = "" ; } ; # P R Q S
54 like ($@, $FATAL_MSG);
55 is(substr($a,1,-6), 'abc' );# P=Q R S
56 is(substr($a,-3,1), 'x' ); # P Q R S
60 substr($a,3,3) = 'XYZ';
64 substr($a,0,0) = 'ab';
66 substr($a,0,0) = '12345678';
67 is($a, '12345678abcXYZxyz' );
68 substr($a,-3,3) = 'def';
69 is($a, '12345678abcXYZdef');
70 substr($a,-3,3) = '<';
71 is($a, '12345678abcXYZ<' );
72 substr($a,-1,1) = '12345678';
73 is($a, '12345678abcXYZ12345678' );
77 is(substr($a,6), 'xyz' ); # P Q R=S
78 is(substr($a,-3), 'xyz' ); # P Q R=S
79 $b = substr($a,999,999) ; # warning # P R=S Q
81 eval{substr($a,999,999) = "" ; } ; # P R=S Q
83 is(substr($a,0), 'abcdefxyz'); # P=Q R=S
84 is(substr($a,9), ''); # P Q=R=S
85 is(substr($a,-11), 'abcdefxyz'); # Q P R=S
86 is(substr($a,-9), 'abcdefxyz'); # P=Q R=S
90 $b = substr($a,-7, 1) ; # warn # Q R P S
92 eval{substr($a,-7, 1) = "" ; }; # Q R P S
94 $b = substr($a,-7,-6) ; # warn # Q R P S
96 eval{substr($a,-7,-6) = "" ; }; # Q R P S
98 is(substr($a,-5,-7), ''); # R P=Q S
99 is(substr($a, 2,-7), ''); # R P Q S
100 is(substr($a,-3,-7), ''); # R P Q S
101 is(substr($a, 2,-5), ''); # P=R Q S
102 is(substr($a,-3,-5), ''); # P=R Q S
103 is(substr($a, 2,-4), ''); # P R Q S
104 is(substr($a,-3,-4), ''); # P R Q S
105 is(substr($a, 5,-6), ''); # R P Q=S
106 is(substr($a, 5,-5), ''); # P=R Q S
107 is(substr($a, 5,-3), ''); # P R Q=S
108 $b = substr($a, 7,-7) ; # warn # R P S Q
110 eval{substr($a, 7,-7) = "" ; }; # R P S Q
111 like($@, $FATAL_MSG);
112 $b = substr($a, 7,-5) ; # warn # P=R S Q
114 eval{substr($a, 7,-5) = "" ; }; # P=R S Q
115 like($@, $FATAL_MSG);
116 $b = substr($a, 7,-3) ; # warn # P Q S Q
118 eval{substr($a, 7,-3) = "" ; }; # P Q S Q
119 like($@, $FATAL_MSG);
120 $b = substr($a, 7, 0) ; # warn # P S Q=R
122 eval{substr($a, 7, 0) = "" ; }; # P S Q=R
123 like($@, $FATAL_MSG);
125 is(substr($a,-7,2), ''); # Q P=R S
126 is(substr($a,-7,4), '54'); # Q P R S
127 is(substr($a,-7,7), '54321');# Q P R=S
128 is(substr($a,-7,9), '54321');# Q P S R
129 is(substr($a,-5,0), ''); # P=Q=R S
130 is(substr($a,-5,3), '543');# P=Q R S
131 is(substr($a,-5,5), '54321');# P=Q R=S
132 is(substr($a,-5,7), '54321');# P=Q S R
133 is(substr($a,-3,0), ''); # P Q=R S
134 is(substr($a,-3,3), '321');# P Q R=S
135 is(substr($a,-2,3), '21'); # P Q S R
136 is(substr($a,0,-5), ''); # P=Q=R S
137 is(substr($a,2,-3), ''); # P Q=R S
138 is(substr($a,0,0), ''); # P=Q=R S
139 is(substr($a,0,5), '54321');# P=Q R=S
140 is(substr($a,0,7), '54321');# P=Q S R
141 is(substr($a,2,0), ''); # P Q=R S
142 is(substr($a,2,3), '321'); # P Q R=S
143 is(substr($a,5,0), ''); # P Q=R=S
144 is(substr($a,5,2), ''); # P Q=S R
145 is(substr($a,-7,-5), ''); # Q P=R S
146 is(substr($a,-7,-2), '543');# Q P R S
147 is(substr($a,-5,-5), ''); # P=Q=R S
148 is(substr($a,-5,-2), '543');# P=Q R S
149 is(substr($a,-3,-3), ''); # P Q=R S
150 is(substr($a,-3,-1), '32');# P Q R S
154 is(substr($a,-2,2), ''); # Q P=R=S
155 is(substr($a,0,0), ''); # P=Q=R=S
156 is(substr($a,0,1), ''); # P=Q=S R
157 is(substr($a,-2,3), ''); # Q P=S R
158 is(substr($a,-2), ''); # Q P=R=S
159 is(substr($a,0), ''); # P=Q=R=S
162 is(substr($a,0,-1), ''); # R P=Q=S
163 $b = substr($a,-2, 0) ; # warn # Q=R P=S
165 eval{substr($a,-2, 0) = "" ; }; # Q=R P=S
166 like($@, $FATAL_MSG);
168 $b = substr($a,-2, 1) ; # warn # Q R P=S
170 eval{substr($a,-2, 1) = "" ; }; # Q R P=S
171 like($@, $FATAL_MSG);
173 $b = substr($a,-2,-1) ; # warn # Q R P=S
175 eval{substr($a,-2,-1) = "" ; }; # Q R P=S
176 like($@, $FATAL_MSG);
178 $b = substr($a,-2,-2) ; # warn # Q=R P=S
180 eval{substr($a,-2,-2) = "" ; }; # Q=R P=S
181 like($@, $FATAL_MSG);
183 $b = substr($a, 1,-2) ; # warn # R P=S Q
185 eval{substr($a, 1,-2) = "" ; }; # R P=S Q
186 like($@, $FATAL_MSG);
188 $b = substr($a, 1, 1) ; # warn # P=S Q R
190 eval{substr($a, 1, 1) = "" ; }; # P=S Q R
191 like($@, $FATAL_MSG);
193 $b = substr($a, 1, 0) ;# warn # P=S Q=R
195 eval{substr($a, 1, 0) = "" ; }; # P=S Q=R
196 like($@, $FATAL_MSG);
198 $b = substr($a,1) ; # warning # P=R=S Q
200 eval{substr($a,1) = "" ; }; # P=R=S Q
201 like($@, $FATAL_MSG);
210 substr($a,0,2) = 'pq';
212 substr($a,2,0) = 'r';
214 substr($a,8,0) = 'asd';
215 is($a, 'pqrcvbnmasd');
216 substr($a,0,2) = 'iop';
217 is($a, 'ioprcvbnmasd');
218 substr($a,0,5) = 'fgh';
219 is($a, 'fghvbnmasd');
220 substr($a,3,5) = 'jkl';
222 substr($a,3,2) = '1234';
223 is($a, 'fgh1234lsd');
226 # with lexicals (and in re-entered scopes)
231 substr($txt, -1) = "X";
235 substr($txt, 0, 1) = "X";
241 # coercion of references
244 substr($s, 0, 1) = 'Foo';
245 is (substr($s,0,7), "FooRRAY");
250 # check no spurious warnings
253 # check new 4 arg replacement syntax
256 is(substr($a, 0, 3, ""), "abc");
258 is(substr($a, 0, 0, "abc"), "");
260 is(substr($a, 3, -1, ""), "xy");
263 is(substr($a, 3, undef, "xy"), "");
269 is(substr($a, 3, 9999999, ""), "xyz");
271 eval{substr($a, -99, 0, "") };
272 like($@, $FATAL_MSG);
273 eval{substr($a, 99, 3, "") };
274 like($@, $FATAL_MSG);
276 substr($a, 0, length($a), "foo");
280 # using 4 arg substr as lvalue is a compile time error
281 eval 'substr($a,0,0,"") = "abc"';
282 like ($@, qr/Can't modify substr/);
286 is(sub { shift }->(substr($a, 0, 4, "xxxx")), 'abcd');
297 my $x = substr("a\x{263a}b",0);
303 substr($x,0,1) = "abcd";
304 is($x, "abcd\x{263a}");
308 is($x, "\x{263a}dcba");
311 $z = "21\x{263a}" . $z;
313 is($z, "21\x{263a}10");
316 # replacement should work on magical values
319 tie $data{'a'}, 'Tie::StdScalar'; # makes $data{'a'} magical
320 $data{a} = "firstlast";
321 is(substr($data{'a'}, 0, 5, ""), "first");
322 is($data{'a'}, "last");
326 # The following two originally from Ignasi Roca.
329 substr($x, 0, 1) = "\x{100}"; # Ignasi had \x{FF}
331 is($x, "\x{100}\xF2\xF3");
332 is(substr($x, 0, 1), "\x{100}");
333 is(substr($x, 1, 1), "\x{F2}");
334 is(substr($x, 2, 1), "\x{F3}");
337 substr($x, 0, 1) = "\x{100}\x{FF}"; # Ignasi had \x{FF}
339 is($x, "\x{100}\x{FF}\xF2\xF3");
340 is(substr($x, 0, 1), "\x{100}");
341 is(substr($x, 1, 1), "\x{FF}");
342 is(substr($x, 2, 1), "\x{F2}");
343 is(substr($x, 3, 1), "\x{F3}");
345 # more utf8 lval exercise
348 substr($x, 0, 2) = "\x{100}\xFF";
350 is($x, "\x{100}\xFF\xF3");
351 is(substr($x, 0, 1), "\x{100}");
352 is(substr($x, 1, 1), "\x{FF}");
353 is(substr($x, 2, 1), "\x{F3}");
356 substr($x, 1, 1) = "\x{100}\xFF";
358 is($x, "\xF1\x{100}\xFF\xF3");
359 is(substr($x, 0, 1), "\x{F1}");
360 is(substr($x, 1, 1), "\x{100}");
361 is(substr($x, 2, 1), "\x{FF}");
362 is(substr($x, 3, 1), "\x{F3}");
365 substr($x, 2, 1) = "\x{100}\xFF";
367 is($x, "\xF1\xF2\x{100}\xFF");
368 is(substr($x, 0, 1), "\x{F1}");
369 is(substr($x, 1, 1), "\x{F2}");
370 is(substr($x, 2, 1), "\x{100}");
371 is(substr($x, 3, 1), "\x{FF}");
374 substr($x, 3, 1) = "\x{100}\xFF";
376 is($x, "\xF1\xF2\xF3\x{100}\xFF");
377 is(substr($x, 0, 1), "\x{F1}");
378 is(substr($x, 1, 1), "\x{F2}");
379 is(substr($x, 2, 1), "\x{F3}");
380 is(substr($x, 3, 1), "\x{100}");
381 is(substr($x, 4, 1), "\x{FF}");
384 substr($x, -1, 1) = "\x{100}\xFF";
386 is($x, "\xF1\xF2\x{100}\xFF");
387 is(substr($x, 0, 1), "\x{F1}");
388 is(substr($x, 1, 1), "\x{F2}");
389 is(substr($x, 2, 1), "\x{100}");
390 is(substr($x, 3, 1), "\x{FF}");
393 substr($x, -1, 0) = "\x{100}\xFF";
395 is($x, "\xF1\xF2\x{100}\xFF\xF3");
396 is(substr($x, 0, 1), "\x{F1}");
397 is(substr($x, 1, 1), "\x{F2}");
398 is(substr($x, 2, 1), "\x{100}");
399 is(substr($x, 3, 1), "\x{FF}");
400 is(substr($x, 4, 1), "\x{F3}");
403 substr($x, 0, -1) = "\x{100}\xFF";
405 is($x, "\x{100}\xFF\xF3");
406 is(substr($x, 0, 1), "\x{100}");
407 is(substr($x, 1, 1), "\x{FF}");
408 is(substr($x, 2, 1), "\x{F3}");
411 substr($x, 0, -2) = "\x{100}\xFF";
413 is($x, "\x{100}\xFF\xF2\xF3");
414 is(substr($x, 0, 1), "\x{100}");
415 is(substr($x, 1, 1), "\x{FF}");
416 is(substr($x, 2, 1), "\x{F2}");
417 is(substr($x, 3, 1), "\x{F3}");
420 substr($x, 0, -3) = "\x{100}\xFF";
422 is($x, "\x{100}\xFF\xF1\xF2\xF3");
423 is(substr($x, 0, 1), "\x{100}");
424 is(substr($x, 1, 1), "\x{FF}");
425 is(substr($x, 2, 1), "\x{F1}");
426 is(substr($x, 3, 1), "\x{F2}");
427 is(substr($x, 4, 1), "\x{F3}");
430 substr($x, 1, -1) = "\x{100}\xFF";
432 is($x, "\xF1\x{100}\xFF\xF3");
433 is(substr($x, 0, 1), "\x{F1}");
434 is(substr($x, 1, 1), "\x{100}");
435 is(substr($x, 2, 1), "\x{FF}");
436 is(substr($x, 3, 1), "\x{F3}");
439 substr($x, -1, -1) = "\x{100}\xFF";
441 is($x, "\xF1\xF2\x{100}\xFF\xF3");
442 is(substr($x, 0, 1), "\x{F1}");
443 is(substr($x, 1, 1), "\x{F2}");
444 is(substr($x, 2, 1), "\x{100}");
445 is(substr($x, 3, 1), "\x{FF}");
446 is(substr($x, 4, 1), "\x{F3}");
448 # And tests for already-UTF8 one
450 $x = "\x{101}\x{F2}\x{F3}";
451 substr($x, 0, 1) = "\x{100}";
453 is($x, "\x{100}\xF2\xF3");
454 is(substr($x, 0, 1), "\x{100}");
455 is(substr($x, 1, 1), "\x{F2}");
456 is(substr($x, 2, 1), "\x{F3}");
458 $x = "\x{101}\x{F2}\x{F3}";
459 substr($x, 0, 1) = "\x{100}\x{FF}";
461 is($x, "\x{100}\x{FF}\xF2\xF3");
462 is(substr($x, 0, 1), "\x{100}");
463 is(substr($x, 1, 1), "\x{FF}");
464 is(substr($x, 2, 1), "\x{F2}");
465 is(substr($x, 3, 1), "\x{F3}");
467 $x = "\x{101}\x{F2}\x{F3}";
468 substr($x, 0, 2) = "\x{100}\xFF";
470 is($x, "\x{100}\xFF\xF3");
471 is(substr($x, 0, 1), "\x{100}");
472 is(substr($x, 1, 1), "\x{FF}");
473 is(substr($x, 2, 1), "\x{F3}");
475 $x = "\x{101}\x{F2}\x{F3}";
476 substr($x, 1, 1) = "\x{100}\xFF";
478 is($x, "\x{101}\x{100}\xFF\xF3");
479 is(substr($x, 0, 1), "\x{101}");
480 is(substr($x, 1, 1), "\x{100}");
481 is(substr($x, 2, 1), "\x{FF}");
482 is(substr($x, 3, 1), "\x{F3}");
484 $x = "\x{101}\x{F2}\x{F3}";
485 substr($x, 2, 1) = "\x{100}\xFF";
487 is($x, "\x{101}\xF2\x{100}\xFF");
488 is(substr($x, 0, 1), "\x{101}");
489 is(substr($x, 1, 1), "\x{F2}");
490 is(substr($x, 2, 1), "\x{100}");
491 is(substr($x, 3, 1), "\x{FF}");
493 $x = "\x{101}\x{F2}\x{F3}";
494 substr($x, 3, 1) = "\x{100}\xFF";
496 is($x, "\x{101}\x{F2}\x{F3}\x{100}\xFF");
497 is(substr($x, 0, 1), "\x{101}");
498 is(substr($x, 1, 1), "\x{F2}");
499 is(substr($x, 2, 1), "\x{F3}");
500 is(substr($x, 3, 1), "\x{100}");
501 is(substr($x, 4, 1), "\x{FF}");
503 $x = "\x{101}\x{F2}\x{F3}";
504 substr($x, -1, 1) = "\x{100}\xFF";
506 is($x, "\x{101}\xF2\x{100}\xFF");
507 is(substr($x, 0, 1), "\x{101}");
508 is(substr($x, 1, 1), "\x{F2}");
509 is(substr($x, 2, 1), "\x{100}");
510 is(substr($x, 3, 1), "\x{FF}");
512 $x = "\x{101}\x{F2}\x{F3}";
513 substr($x, -1, 0) = "\x{100}\xFF";
515 is($x, "\x{101}\xF2\x{100}\xFF\xF3");
516 is(substr($x, 0, 1), "\x{101}");
517 is(substr($x, 1, 1), "\x{F2}");
518 is(substr($x, 2, 1), "\x{100}");
519 is(substr($x, 3, 1), "\x{FF}");
520 is(substr($x, 4, 1), "\x{F3}");
522 $x = "\x{101}\x{F2}\x{F3}";
523 substr($x, 0, -1) = "\x{100}\xFF";
525 is($x, "\x{100}\xFF\xF3");
526 is(substr($x, 0, 1), "\x{100}");
527 is(substr($x, 1, 1), "\x{FF}");
528 is(substr($x, 2, 1), "\x{F3}");
530 $x = "\x{101}\x{F2}\x{F3}";
531 substr($x, 0, -2) = "\x{100}\xFF";
533 is($x, "\x{100}\xFF\xF2\xF3");
534 is(substr($x, 0, 1), "\x{100}");
535 is(substr($x, 1, 1), "\x{FF}");
536 is(substr($x, 2, 1), "\x{F2}");
537 is(substr($x, 3, 1), "\x{F3}");
539 $x = "\x{101}\x{F2}\x{F3}";
540 substr($x, 0, -3) = "\x{100}\xFF";
542 is($x, "\x{100}\xFF\x{101}\x{F2}\x{F3}");
543 is(substr($x, 0, 1), "\x{100}");
544 is(substr($x, 1, 1), "\x{FF}");
545 is(substr($x, 2, 1), "\x{101}");
546 is(substr($x, 3, 1), "\x{F2}");
547 is(substr($x, 4, 1), "\x{F3}");
549 $x = "\x{101}\x{F2}\x{F3}";
550 substr($x, 1, -1) = "\x{100}\xFF";
552 is($x, "\x{101}\x{100}\xFF\xF3");
553 is(substr($x, 0, 1), "\x{101}");
554 is(substr($x, 1, 1), "\x{100}");
555 is(substr($x, 2, 1), "\x{FF}");
556 is(substr($x, 3, 1), "\x{F3}");
558 $x = "\x{101}\x{F2}\x{F3}";
559 substr($x, -1, -1) = "\x{100}\xFF";
561 is($x, "\x{101}\xF2\x{100}\xFF\xF3");
562 is(substr($x, 0, 1), "\x{101}");
563 is(substr($x, 1, 1), "\x{F2}");
564 is(substr($x, 2, 1), "\x{100}");
565 is(substr($x, 3, 1), "\x{FF}");
566 is(substr($x, 4, 1), "\x{F3}");
568 substr($x = "ab", 0, 0, "\x{100}\x{200}");
569 is($x, "\x{100}\x{200}ab");
571 substr($x = "\x{100}\x{200}", 0, 0, "ab");
572 is($x, "ab\x{100}\x{200}");
574 substr($x = "ab", 1, 0, "\x{100}\x{200}");
575 is($x, "a\x{100}\x{200}b");
577 substr($x = "\x{100}\x{200}", 1, 0, "ab");
578 is($x, "\x{100}ab\x{200}");
580 substr($x = "ab", 2, 0, "\x{100}\x{200}");
581 is($x, "ab\x{100}\x{200}");
583 substr($x = "\x{100}\x{200}", 2, 0, "ab");
584 is($x, "\x{100}\x{200}ab");
586 substr($x = "\xFFb", 0, 0, "\x{100}\x{200}");
587 is($x, "\x{100}\x{200}\xFFb");
589 substr($x = "\x{100}\x{200}", 0, 0, "\xFFb");
590 is($x, "\xFFb\x{100}\x{200}");
592 substr($x = "\xFFb", 1, 0, "\x{100}\x{200}");
593 is($x, "\xFF\x{100}\x{200}b");
595 substr($x = "\x{100}\x{200}", 1, 0, "\xFFb");
596 is($x, "\x{100}\xFFb\x{200}");
598 substr($x = "\xFFb", 2, 0, "\x{100}\x{200}");
599 is($x, "\xFFb\x{100}\x{200}");
601 substr($x = "\x{100}\x{200}", 2, 0, "\xFFb");
602 is($x, "\x{100}\x{200}\xFFb");
608 $r[$_] = \ substr $s, $_, 1 for (0, 1);
609 is(join("", map { $$_ } @r), "ab");
615 substr($_[0],0,1) ^= substr($_[0],1,1) ^=
616 substr($_[0],0,1) ^= substr($_[0],1,1);
618 my $x = my $y = 'AB'; ss $x; ss $y;
624 my $x = "0123456789\x{500}";
625 my $y = substr $x, 4;
626 is(substr($x, 7, 1), "7");
629 # multiple assignments to lvalue [perl #24346]
632 for (substr($x,1,3)) {
640 $_ = "\xF1\xF2\xF3\xF4\xF5\xF6";
641 is($_, "\xF1\xF2\xF3\xF4\xF5\xF6");
642 is($x, "a\xF1\xF2\xF3\xF4\xF5\xF6ef");
649 # [perl #24200] string corruption with lvalue sub
652 sub bar: lvalue { substr $krunch, 0 }
655 $krunch = '123456789';
656 is(bar, '123456789');
661 my $text = "0123456789\xED ";
662 utf8::upgrade($text);
665 my $a = substr($text, $pos, $pos);
666 is(substr($text,$pos,1), $pos);
672 my $a = pack("C", 0xbf);
673 substr($a, -1) &= chr(0xfeff);
677 # [perl #34976] incorrect caching of utf8 substr length
679 my $a = "abcd\x{100}";
680 is(substr($a,1,2), 'bc');
681 is(substr($a,1,1), 'b');