3 #P = start of string Q = start of substr R = end of substr S = end of string
10 no warnings 'deprecated';
13 $SIG{__WARN__} = sub {
14 if ($_[0] =~ /^substr outside of string/) {
16 } elsif ($_[0] =~ /^Attempt to use reference as lvalue in substr/) {
18 } elsif ($_[0] =~ /^Use of uninitialized value/) {
29 run_tests() unless caller;
35 $FATAL_MSG = qr/^substr outside of string/;
37 is(substr($a,0,3), 'abc'); # P=Q R S
38 is(substr($a,3,3), 'def'); # P Q R S
39 is(substr($a,6,999), 'xyz'); # P Q S R
40 $b = substr($a,999,999) ; # warn # P R Q S
42 eval{substr($a,999,999) = "" ; };# P R Q S
43 like ($@, $FATAL_MSG);
44 is(substr($a,0,-6), 'abc'); # P=Q R S
45 is(substr($a,-3,1), 'x'); # P Q R S
49 is(substr($a,1,3), 'abc' ); # P=Q R S
50 is(substr($a,4,3), 'def' ); # P Q R S
51 is(substr($a,7,999), 'xyz');# P Q S R
52 $b = substr($a,999,999) ; # warn # P R Q S
54 eval{substr($a,999,999) = "" ; } ; # P R Q S
55 like ($@, $FATAL_MSG);
56 is(substr($a,1,-6), 'abc' );# P=Q R S
57 is(substr($a,-3,1), 'x' ); # P Q R S
61 substr($a,3,3) = 'XYZ';
65 substr($a,0,0) = 'ab';
67 substr($a,0,0) = '12345678';
68 is($a, '12345678abcXYZxyz' );
69 substr($a,-3,3) = 'def';
70 is($a, '12345678abcXYZdef');
71 substr($a,-3,3) = '<';
72 is($a, '12345678abcXYZ<' );
73 substr($a,-1,1) = '12345678';
74 is($a, '12345678abcXYZ12345678' );
78 is(substr($a,6), 'xyz' ); # P Q R=S
79 is(substr($a,-3), 'xyz' ); # P Q R=S
80 $b = substr($a,999,999) ; # warning # P R=S Q
82 eval{substr($a,999,999) = "" ; } ; # P R=S Q
84 is(substr($a,0), 'abcdefxyz'); # P=Q R=S
85 is(substr($a,9), ''); # P Q=R=S
86 is(substr($a,-11), 'abcdefxyz'); # Q P R=S
87 is(substr($a,-9), 'abcdefxyz'); # P=Q R=S
91 $b = substr($a,-7, 1) ; # warn # Q R P S
93 eval{substr($a,-7, 1) = "" ; }; # Q R P S
95 $b = substr($a,-7,-6) ; # warn # Q R P S
97 eval{substr($a,-7,-6) = "" ; }; # Q R P S
99 is(substr($a,-5,-7), ''); # R P=Q S
100 is(substr($a, 2,-7), ''); # R P Q S
101 is(substr($a,-3,-7), ''); # R P Q S
102 is(substr($a, 2,-5), ''); # P=R Q S
103 is(substr($a,-3,-5), ''); # P=R Q S
104 is(substr($a, 2,-4), ''); # P R Q S
105 is(substr($a,-3,-4), ''); # P R Q S
106 is(substr($a, 5,-6), ''); # R P Q=S
107 is(substr($a, 5,-5), ''); # P=R Q S
108 is(substr($a, 5,-3), ''); # P R Q=S
109 $b = substr($a, 7,-7) ; # warn # R P S Q
111 eval{substr($a, 7,-7) = "" ; }; # R P S Q
112 like($@, $FATAL_MSG);
113 $b = substr($a, 7,-5) ; # warn # P=R S Q
115 eval{substr($a, 7,-5) = "" ; }; # P=R S Q
116 like($@, $FATAL_MSG);
117 $b = substr($a, 7,-3) ; # warn # P Q S Q
119 eval{substr($a, 7,-3) = "" ; }; # P Q S Q
120 like($@, $FATAL_MSG);
121 $b = substr($a, 7, 0) ; # warn # P S Q=R
123 eval{substr($a, 7, 0) = "" ; }; # P S Q=R
124 like($@, $FATAL_MSG);
126 is(substr($a,-7,2), ''); # Q P=R S
127 is(substr($a,-7,4), '54'); # Q P R S
128 is(substr($a,-7,7), '54321');# Q P R=S
129 is(substr($a,-7,9), '54321');# Q P S R
130 is(substr($a,-5,0), ''); # P=Q=R S
131 is(substr($a,-5,3), '543');# P=Q R S
132 is(substr($a,-5,5), '54321');# P=Q R=S
133 is(substr($a,-5,7), '54321');# P=Q S R
134 is(substr($a,-3,0), ''); # P Q=R S
135 is(substr($a,-3,3), '321');# P Q R=S
136 is(substr($a,-2,3), '21'); # P Q S R
137 is(substr($a,0,-5), ''); # P=Q=R S
138 is(substr($a,2,-3), ''); # P Q=R S
139 is(substr($a,0,0), ''); # P=Q=R S
140 is(substr($a,0,5), '54321');# P=Q R=S
141 is(substr($a,0,7), '54321');# P=Q S R
142 is(substr($a,2,0), ''); # P Q=R S
143 is(substr($a,2,3), '321'); # P Q R=S
144 is(substr($a,5,0), ''); # P Q=R=S
145 is(substr($a,5,2), ''); # P Q=S R
146 is(substr($a,-7,-5), ''); # Q P=R S
147 is(substr($a,-7,-2), '543');# Q P R S
148 is(substr($a,-5,-5), ''); # P=Q=R S
149 is(substr($a,-5,-2), '543');# P=Q R S
150 is(substr($a,-3,-3), ''); # P Q=R S
151 is(substr($a,-3,-1), '32');# P Q R S
155 is(substr($a,-2,2), ''); # Q P=R=S
156 is(substr($a,0,0), ''); # P=Q=R=S
157 is(substr($a,0,1), ''); # P=Q=S R
158 is(substr($a,-2,3), ''); # Q P=S R
159 is(substr($a,-2), ''); # Q P=R=S
160 is(substr($a,0), ''); # P=Q=R=S
163 is(substr($a,0,-1), ''); # R P=Q=S
164 $b = substr($a,-2, 0) ; # warn # Q=R P=S
166 eval{substr($a,-2, 0) = "" ; }; # Q=R P=S
167 like($@, $FATAL_MSG);
169 $b = substr($a,-2, 1) ; # warn # Q R P=S
171 eval{substr($a,-2, 1) = "" ; }; # Q R P=S
172 like($@, $FATAL_MSG);
174 $b = substr($a,-2,-1) ; # warn # Q R P=S
176 eval{substr($a,-2,-1) = "" ; }; # Q R P=S
177 like($@, $FATAL_MSG);
179 $b = substr($a,-2,-2) ; # warn # Q=R P=S
181 eval{substr($a,-2,-2) = "" ; }; # Q=R P=S
182 like($@, $FATAL_MSG);
184 $b = substr($a, 1,-2) ; # warn # R P=S Q
186 eval{substr($a, 1,-2) = "" ; }; # R P=S Q
187 like($@, $FATAL_MSG);
189 $b = substr($a, 1, 1) ; # warn # P=S Q R
191 eval{substr($a, 1, 1) = "" ; }; # P=S Q R
192 like($@, $FATAL_MSG);
194 $b = substr($a, 1, 0) ;# warn # P=S Q=R
196 eval{substr($a, 1, 0) = "" ; }; # P=S Q=R
197 like($@, $FATAL_MSG);
199 $b = substr($a,1) ; # warning # P=R=S Q
201 eval{substr($a,1) = "" ; }; # P=R=S Q
202 like($@, $FATAL_MSG);
211 substr($a,0,2) = 'pq';
213 substr($a,2,0) = 'r';
215 substr($a,8,0) = 'asd';
216 is($a, 'pqrcvbnmasd');
217 substr($a,0,2) = 'iop';
218 is($a, 'ioprcvbnmasd');
219 substr($a,0,5) = 'fgh';
220 is($a, 'fghvbnmasd');
221 substr($a,3,5) = 'jkl';
223 substr($a,3,2) = '1234';
224 is($a, 'fgh1234lsd');
227 # with lexicals (and in re-entered scopes)
232 substr($txt, -1) = "X";
236 substr($txt, 0, 1) = "X";
242 # coercion of references
245 substr($s, 0, 1) = 'Foo';
246 is (substr($s,0,7), "FooRRAY");
251 # check no spurious warnings
254 # check new 4 arg replacement syntax
257 is(substr($a, 0, 3, ""), "abc");
259 is(substr($a, 0, 0, "abc"), "");
261 is(substr($a, 3, -1, ""), "xy");
264 is(substr($a, 3, undef, "xy"), "");
270 is(substr($a, 3, 9999999, ""), "xyz");
272 eval{substr($a, -99, 0, "") };
273 like($@, $FATAL_MSG);
274 eval{substr($a, 99, 3, "") };
275 like($@, $FATAL_MSG);
277 substr($a, 0, length($a), "foo");
281 # using 4 arg substr as lvalue is a compile time error
282 eval 'substr($a,0,0,"") = "abc"';
283 like ($@, qr/Can't modify substr/);
287 is(sub { shift }->(substr($a, 0, 4, "xxxx")), 'abcd');
298 my $x = substr("a\x{263a}b",0);
304 substr($x,0,1) = "abcd";
305 is($x, "abcd\x{263a}");
309 is($x, "\x{263a}dcba");
312 $z = "21\x{263a}" . $z;
314 is($z, "21\x{263a}10");
317 # replacement should work on magical values
320 tie $data{'a'}, 'Tie::StdScalar'; # makes $data{'a'} magical
321 $data{a} = "firstlast";
322 is(substr($data{'a'}, 0, 5, ""), "first");
323 is($data{'a'}, "last");
327 # The following two originally from Ignasi Roca.
330 substr($x, 0, 1) = "\x{100}"; # Ignasi had \x{FF}
332 is($x, "\x{100}\xF2\xF3");
333 is(substr($x, 0, 1), "\x{100}");
334 is(substr($x, 1, 1), "\x{F2}");
335 is(substr($x, 2, 1), "\x{F3}");
338 substr($x, 0, 1) = "\x{100}\x{FF}"; # Ignasi had \x{FF}
340 is($x, "\x{100}\x{FF}\xF2\xF3");
341 is(substr($x, 0, 1), "\x{100}");
342 is(substr($x, 1, 1), "\x{FF}");
343 is(substr($x, 2, 1), "\x{F2}");
344 is(substr($x, 3, 1), "\x{F3}");
346 # more utf8 lval exercise
349 substr($x, 0, 2) = "\x{100}\xFF";
351 is($x, "\x{100}\xFF\xF3");
352 is(substr($x, 0, 1), "\x{100}");
353 is(substr($x, 1, 1), "\x{FF}");
354 is(substr($x, 2, 1), "\x{F3}");
357 substr($x, 1, 1) = "\x{100}\xFF";
359 is($x, "\xF1\x{100}\xFF\xF3");
360 is(substr($x, 0, 1), "\x{F1}");
361 is(substr($x, 1, 1), "\x{100}");
362 is(substr($x, 2, 1), "\x{FF}");
363 is(substr($x, 3, 1), "\x{F3}");
366 substr($x, 2, 1) = "\x{100}\xFF";
368 is($x, "\xF1\xF2\x{100}\xFF");
369 is(substr($x, 0, 1), "\x{F1}");
370 is(substr($x, 1, 1), "\x{F2}");
371 is(substr($x, 2, 1), "\x{100}");
372 is(substr($x, 3, 1), "\x{FF}");
375 substr($x, 3, 1) = "\x{100}\xFF";
377 is($x, "\xF1\xF2\xF3\x{100}\xFF");
378 is(substr($x, 0, 1), "\x{F1}");
379 is(substr($x, 1, 1), "\x{F2}");
380 is(substr($x, 2, 1), "\x{F3}");
381 is(substr($x, 3, 1), "\x{100}");
382 is(substr($x, 4, 1), "\x{FF}");
385 substr($x, -1, 1) = "\x{100}\xFF";
387 is($x, "\xF1\xF2\x{100}\xFF");
388 is(substr($x, 0, 1), "\x{F1}");
389 is(substr($x, 1, 1), "\x{F2}");
390 is(substr($x, 2, 1), "\x{100}");
391 is(substr($x, 3, 1), "\x{FF}");
394 substr($x, -1, 0) = "\x{100}\xFF";
396 is($x, "\xF1\xF2\x{100}\xFF\xF3");
397 is(substr($x, 0, 1), "\x{F1}");
398 is(substr($x, 1, 1), "\x{F2}");
399 is(substr($x, 2, 1), "\x{100}");
400 is(substr($x, 3, 1), "\x{FF}");
401 is(substr($x, 4, 1), "\x{F3}");
404 substr($x, 0, -1) = "\x{100}\xFF";
406 is($x, "\x{100}\xFF\xF3");
407 is(substr($x, 0, 1), "\x{100}");
408 is(substr($x, 1, 1), "\x{FF}");
409 is(substr($x, 2, 1), "\x{F3}");
412 substr($x, 0, -2) = "\x{100}\xFF";
414 is($x, "\x{100}\xFF\xF2\xF3");
415 is(substr($x, 0, 1), "\x{100}");
416 is(substr($x, 1, 1), "\x{FF}");
417 is(substr($x, 2, 1), "\x{F2}");
418 is(substr($x, 3, 1), "\x{F3}");
421 substr($x, 0, -3) = "\x{100}\xFF";
423 is($x, "\x{100}\xFF\xF1\xF2\xF3");
424 is(substr($x, 0, 1), "\x{100}");
425 is(substr($x, 1, 1), "\x{FF}");
426 is(substr($x, 2, 1), "\x{F1}");
427 is(substr($x, 3, 1), "\x{F2}");
428 is(substr($x, 4, 1), "\x{F3}");
431 substr($x, 1, -1) = "\x{100}\xFF";
433 is($x, "\xF1\x{100}\xFF\xF3");
434 is(substr($x, 0, 1), "\x{F1}");
435 is(substr($x, 1, 1), "\x{100}");
436 is(substr($x, 2, 1), "\x{FF}");
437 is(substr($x, 3, 1), "\x{F3}");
440 substr($x, -1, -1) = "\x{100}\xFF";
442 is($x, "\xF1\xF2\x{100}\xFF\xF3");
443 is(substr($x, 0, 1), "\x{F1}");
444 is(substr($x, 1, 1), "\x{F2}");
445 is(substr($x, 2, 1), "\x{100}");
446 is(substr($x, 3, 1), "\x{FF}");
447 is(substr($x, 4, 1), "\x{F3}");
449 # And tests for already-UTF8 one
451 $x = "\x{101}\x{F2}\x{F3}";
452 substr($x, 0, 1) = "\x{100}";
454 is($x, "\x{100}\xF2\xF3");
455 is(substr($x, 0, 1), "\x{100}");
456 is(substr($x, 1, 1), "\x{F2}");
457 is(substr($x, 2, 1), "\x{F3}");
459 $x = "\x{101}\x{F2}\x{F3}";
460 substr($x, 0, 1) = "\x{100}\x{FF}";
462 is($x, "\x{100}\x{FF}\xF2\xF3");
463 is(substr($x, 0, 1), "\x{100}");
464 is(substr($x, 1, 1), "\x{FF}");
465 is(substr($x, 2, 1), "\x{F2}");
466 is(substr($x, 3, 1), "\x{F3}");
468 $x = "\x{101}\x{F2}\x{F3}";
469 substr($x, 0, 2) = "\x{100}\xFF";
471 is($x, "\x{100}\xFF\xF3");
472 is(substr($x, 0, 1), "\x{100}");
473 is(substr($x, 1, 1), "\x{FF}");
474 is(substr($x, 2, 1), "\x{F3}");
476 $x = "\x{101}\x{F2}\x{F3}";
477 substr($x, 1, 1) = "\x{100}\xFF";
479 is($x, "\x{101}\x{100}\xFF\xF3");
480 is(substr($x, 0, 1), "\x{101}");
481 is(substr($x, 1, 1), "\x{100}");
482 is(substr($x, 2, 1), "\x{FF}");
483 is(substr($x, 3, 1), "\x{F3}");
485 $x = "\x{101}\x{F2}\x{F3}";
486 substr($x, 2, 1) = "\x{100}\xFF";
488 is($x, "\x{101}\xF2\x{100}\xFF");
489 is(substr($x, 0, 1), "\x{101}");
490 is(substr($x, 1, 1), "\x{F2}");
491 is(substr($x, 2, 1), "\x{100}");
492 is(substr($x, 3, 1), "\x{FF}");
494 $x = "\x{101}\x{F2}\x{F3}";
495 substr($x, 3, 1) = "\x{100}\xFF";
497 is($x, "\x{101}\x{F2}\x{F3}\x{100}\xFF");
498 is(substr($x, 0, 1), "\x{101}");
499 is(substr($x, 1, 1), "\x{F2}");
500 is(substr($x, 2, 1), "\x{F3}");
501 is(substr($x, 3, 1), "\x{100}");
502 is(substr($x, 4, 1), "\x{FF}");
504 $x = "\x{101}\x{F2}\x{F3}";
505 substr($x, -1, 1) = "\x{100}\xFF";
507 is($x, "\x{101}\xF2\x{100}\xFF");
508 is(substr($x, 0, 1), "\x{101}");
509 is(substr($x, 1, 1), "\x{F2}");
510 is(substr($x, 2, 1), "\x{100}");
511 is(substr($x, 3, 1), "\x{FF}");
513 $x = "\x{101}\x{F2}\x{F3}";
514 substr($x, -1, 0) = "\x{100}\xFF";
516 is($x, "\x{101}\xF2\x{100}\xFF\xF3");
517 is(substr($x, 0, 1), "\x{101}");
518 is(substr($x, 1, 1), "\x{F2}");
519 is(substr($x, 2, 1), "\x{100}");
520 is(substr($x, 3, 1), "\x{FF}");
521 is(substr($x, 4, 1), "\x{F3}");
523 $x = "\x{101}\x{F2}\x{F3}";
524 substr($x, 0, -1) = "\x{100}\xFF";
526 is($x, "\x{100}\xFF\xF3");
527 is(substr($x, 0, 1), "\x{100}");
528 is(substr($x, 1, 1), "\x{FF}");
529 is(substr($x, 2, 1), "\x{F3}");
531 $x = "\x{101}\x{F2}\x{F3}";
532 substr($x, 0, -2) = "\x{100}\xFF";
534 is($x, "\x{100}\xFF\xF2\xF3");
535 is(substr($x, 0, 1), "\x{100}");
536 is(substr($x, 1, 1), "\x{FF}");
537 is(substr($x, 2, 1), "\x{F2}");
538 is(substr($x, 3, 1), "\x{F3}");
540 $x = "\x{101}\x{F2}\x{F3}";
541 substr($x, 0, -3) = "\x{100}\xFF";
543 is($x, "\x{100}\xFF\x{101}\x{F2}\x{F3}");
544 is(substr($x, 0, 1), "\x{100}");
545 is(substr($x, 1, 1), "\x{FF}");
546 is(substr($x, 2, 1), "\x{101}");
547 is(substr($x, 3, 1), "\x{F2}");
548 is(substr($x, 4, 1), "\x{F3}");
550 $x = "\x{101}\x{F2}\x{F3}";
551 substr($x, 1, -1) = "\x{100}\xFF";
553 is($x, "\x{101}\x{100}\xFF\xF3");
554 is(substr($x, 0, 1), "\x{101}");
555 is(substr($x, 1, 1), "\x{100}");
556 is(substr($x, 2, 1), "\x{FF}");
557 is(substr($x, 3, 1), "\x{F3}");
559 $x = "\x{101}\x{F2}\x{F3}";
560 substr($x, -1, -1) = "\x{100}\xFF";
562 is($x, "\x{101}\xF2\x{100}\xFF\xF3");
563 is(substr($x, 0, 1), "\x{101}");
564 is(substr($x, 1, 1), "\x{F2}");
565 is(substr($x, 2, 1), "\x{100}");
566 is(substr($x, 3, 1), "\x{FF}");
567 is(substr($x, 4, 1), "\x{F3}");
569 substr($x = "ab", 0, 0, "\x{100}\x{200}");
570 is($x, "\x{100}\x{200}ab");
572 substr($x = "\x{100}\x{200}", 0, 0, "ab");
573 is($x, "ab\x{100}\x{200}");
575 substr($x = "ab", 1, 0, "\x{100}\x{200}");
576 is($x, "a\x{100}\x{200}b");
578 substr($x = "\x{100}\x{200}", 1, 0, "ab");
579 is($x, "\x{100}ab\x{200}");
581 substr($x = "ab", 2, 0, "\x{100}\x{200}");
582 is($x, "ab\x{100}\x{200}");
584 substr($x = "\x{100}\x{200}", 2, 0, "ab");
585 is($x, "\x{100}\x{200}ab");
587 substr($x = "\xFFb", 0, 0, "\x{100}\x{200}");
588 is($x, "\x{100}\x{200}\xFFb");
590 substr($x = "\x{100}\x{200}", 0, 0, "\xFFb");
591 is($x, "\xFFb\x{100}\x{200}");
593 substr($x = "\xFFb", 1, 0, "\x{100}\x{200}");
594 is($x, "\xFF\x{100}\x{200}b");
596 substr($x = "\x{100}\x{200}", 1, 0, "\xFFb");
597 is($x, "\x{100}\xFFb\x{200}");
599 substr($x = "\xFFb", 2, 0, "\x{100}\x{200}");
600 is($x, "\xFFb\x{100}\x{200}");
602 substr($x = "\x{100}\x{200}", 2, 0, "\xFFb");
603 is($x, "\x{100}\x{200}\xFFb");
609 $r[$_] = \ substr $s, $_, 1 for (0, 1);
610 is(join("", map { $$_ } @r), "ab");
616 substr($_[0],0,1) ^= substr($_[0],1,1) ^=
617 substr($_[0],0,1) ^= substr($_[0],1,1);
619 my $x = my $y = 'AB'; ss $x; ss $y;
625 my $x = "0123456789\x{500}";
626 my $y = substr $x, 4;
627 is(substr($x, 7, 1), "7");
630 # multiple assignments to lvalue [perl #24346]
633 for (substr($x,1,3)) {
641 $_ = "\xF1\xF2\xF3\xF4\xF5\xF6";
642 is($_, "\xF1\xF2\xF3\xF4\xF5\xF6");
643 is($x, "a\xF1\xF2\xF3\xF4\xF5\xF6ef");
650 # [perl #24200] string corruption with lvalue sub
653 sub bar: lvalue { substr $krunch, 0 }
656 $krunch = '123456789';
657 is(bar, '123456789');
662 my $text = "0123456789\xED ";
663 utf8::upgrade($text);
666 my $a = substr($text, $pos, $pos);
667 is(substr($text,$pos,1), $pos);
673 my $a = pack("C", 0xbf);
674 substr($a, -1) &= chr(0xfeff);
678 # [perl #34976] incorrect caching of utf8 substr length
680 my $a = "abcd\x{100}";
681 is(substr($a,1,2), 'bc');
682 is(substr($a,1,1), 'b');