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);
204 $b = substr($a,-7,-6) ; # warn # Q R P S
206 eval{substr($a,-7,-6) = "" ; }; # Q R P S
207 like($@, $FATAL_MSG);
216 substr($a,0,2) = 'pq';
218 substr($a,2,0) = 'r';
220 substr($a,8,0) = 'asd';
221 is($a, 'pqrcvbnmasd');
222 substr($a,0,2) = 'iop';
223 is($a, 'ioprcvbnmasd');
224 substr($a,0,5) = 'fgh';
225 is($a, 'fghvbnmasd');
226 substr($a,3,5) = 'jkl';
228 substr($a,3,2) = '1234';
229 is($a, 'fgh1234lsd');
232 # with lexicals (and in re-entered scopes)
237 substr($txt, -1) = "X";
241 substr($txt, 0, 1) = "X";
247 # coercion of references
250 substr($s, 0, 1) = 'Foo';
251 is (substr($s,0,7), "FooRRAY");
256 # check no spurious warnings
259 # check new 4 arg replacement syntax
262 is(substr($a, 0, 3, ""), "abc");
264 is(substr($a, 0, 0, "abc"), "");
266 is(substr($a, 3, -1, ""), "xy");
269 is(substr($a, 3, undef, "xy"), "");
275 is(substr($a, 3, 9999999, ""), "xyz");
277 eval{substr($a, -99, 0, "") };
278 like($@, $FATAL_MSG);
279 eval{substr($a, 99, 3, "") };
280 like($@, $FATAL_MSG);
282 substr($a, 0, length($a), "foo");
286 # using 4 arg substr as lvalue is a compile time error
287 eval 'substr($a,0,0,"") = "abc"';
288 like ($@, qr/Can't modify substr/);
292 is(sub { shift }->(substr($a, 0, 4, "xxxx")), 'abcd');
303 my $x = substr("a\x{263a}b",0);
309 substr($x,0,1) = "abcd";
310 is($x, "abcd\x{263a}");
314 is($x, "\x{263a}dcba");
317 $z = "21\x{263a}" . $z;
319 is($z, "21\x{263a}10");
322 # replacement should work on magical values
325 tie $data{'a'}, 'Tie::StdScalar'; # makes $data{'a'} magical
326 $data{a} = "firstlast";
327 is(substr($data{'a'}, 0, 5, ""), "first");
328 is($data{'a'}, "last");
332 # The following two originally from Ignasi Roca.
335 substr($x, 0, 1) = "\x{100}"; # Ignasi had \x{FF}
337 is($x, "\x{100}\xF2\xF3");
338 is(substr($x, 0, 1), "\x{100}");
339 is(substr($x, 1, 1), "\x{F2}");
340 is(substr($x, 2, 1), "\x{F3}");
343 substr($x, 0, 1) = "\x{100}\x{FF}"; # Ignasi had \x{FF}
345 is($x, "\x{100}\x{FF}\xF2\xF3");
346 is(substr($x, 0, 1), "\x{100}");
347 is(substr($x, 1, 1), "\x{FF}");
348 is(substr($x, 2, 1), "\x{F2}");
349 is(substr($x, 3, 1), "\x{F3}");
351 # more utf8 lval exercise
354 substr($x, 0, 2) = "\x{100}\xFF";
356 is($x, "\x{100}\xFF\xF3");
357 is(substr($x, 0, 1), "\x{100}");
358 is(substr($x, 1, 1), "\x{FF}");
359 is(substr($x, 2, 1), "\x{F3}");
362 substr($x, 1, 1) = "\x{100}\xFF";
364 is($x, "\xF1\x{100}\xFF\xF3");
365 is(substr($x, 0, 1), "\x{F1}");
366 is(substr($x, 1, 1), "\x{100}");
367 is(substr($x, 2, 1), "\x{FF}");
368 is(substr($x, 3, 1), "\x{F3}");
371 substr($x, 2, 1) = "\x{100}\xFF";
373 is($x, "\xF1\xF2\x{100}\xFF");
374 is(substr($x, 0, 1), "\x{F1}");
375 is(substr($x, 1, 1), "\x{F2}");
376 is(substr($x, 2, 1), "\x{100}");
377 is(substr($x, 3, 1), "\x{FF}");
380 substr($x, 3, 1) = "\x{100}\xFF";
382 is($x, "\xF1\xF2\xF3\x{100}\xFF");
383 is(substr($x, 0, 1), "\x{F1}");
384 is(substr($x, 1, 1), "\x{F2}");
385 is(substr($x, 2, 1), "\x{F3}");
386 is(substr($x, 3, 1), "\x{100}");
387 is(substr($x, 4, 1), "\x{FF}");
390 substr($x, -1, 1) = "\x{100}\xFF";
392 is($x, "\xF1\xF2\x{100}\xFF");
393 is(substr($x, 0, 1), "\x{F1}");
394 is(substr($x, 1, 1), "\x{F2}");
395 is(substr($x, 2, 1), "\x{100}");
396 is(substr($x, 3, 1), "\x{FF}");
399 substr($x, -1, 0) = "\x{100}\xFF";
401 is($x, "\xF1\xF2\x{100}\xFF\xF3");
402 is(substr($x, 0, 1), "\x{F1}");
403 is(substr($x, 1, 1), "\x{F2}");
404 is(substr($x, 2, 1), "\x{100}");
405 is(substr($x, 3, 1), "\x{FF}");
406 is(substr($x, 4, 1), "\x{F3}");
409 substr($x, 0, -1) = "\x{100}\xFF";
411 is($x, "\x{100}\xFF\xF3");
412 is(substr($x, 0, 1), "\x{100}");
413 is(substr($x, 1, 1), "\x{FF}");
414 is(substr($x, 2, 1), "\x{F3}");
417 substr($x, 0, -2) = "\x{100}\xFF";
419 is($x, "\x{100}\xFF\xF2\xF3");
420 is(substr($x, 0, 1), "\x{100}");
421 is(substr($x, 1, 1), "\x{FF}");
422 is(substr($x, 2, 1), "\x{F2}");
423 is(substr($x, 3, 1), "\x{F3}");
426 substr($x, 0, -3) = "\x{100}\xFF";
428 is($x, "\x{100}\xFF\xF1\xF2\xF3");
429 is(substr($x, 0, 1), "\x{100}");
430 is(substr($x, 1, 1), "\x{FF}");
431 is(substr($x, 2, 1), "\x{F1}");
432 is(substr($x, 3, 1), "\x{F2}");
433 is(substr($x, 4, 1), "\x{F3}");
436 substr($x, 1, -1) = "\x{100}\xFF";
438 is($x, "\xF1\x{100}\xFF\xF3");
439 is(substr($x, 0, 1), "\x{F1}");
440 is(substr($x, 1, 1), "\x{100}");
441 is(substr($x, 2, 1), "\x{FF}");
442 is(substr($x, 3, 1), "\x{F3}");
445 substr($x, -1, -1) = "\x{100}\xFF";
447 is($x, "\xF1\xF2\x{100}\xFF\xF3");
448 is(substr($x, 0, 1), "\x{F1}");
449 is(substr($x, 1, 1), "\x{F2}");
450 is(substr($x, 2, 1), "\x{100}");
451 is(substr($x, 3, 1), "\x{FF}");
452 is(substr($x, 4, 1), "\x{F3}");
454 # And tests for already-UTF8 one
456 $x = "\x{101}\x{F2}\x{F3}";
457 substr($x, 0, 1) = "\x{100}";
459 is($x, "\x{100}\xF2\xF3");
460 is(substr($x, 0, 1), "\x{100}");
461 is(substr($x, 1, 1), "\x{F2}");
462 is(substr($x, 2, 1), "\x{F3}");
464 $x = "\x{101}\x{F2}\x{F3}";
465 substr($x, 0, 1) = "\x{100}\x{FF}";
467 is($x, "\x{100}\x{FF}\xF2\xF3");
468 is(substr($x, 0, 1), "\x{100}");
469 is(substr($x, 1, 1), "\x{FF}");
470 is(substr($x, 2, 1), "\x{F2}");
471 is(substr($x, 3, 1), "\x{F3}");
473 $x = "\x{101}\x{F2}\x{F3}";
474 substr($x, 0, 2) = "\x{100}\xFF";
476 is($x, "\x{100}\xFF\xF3");
477 is(substr($x, 0, 1), "\x{100}");
478 is(substr($x, 1, 1), "\x{FF}");
479 is(substr($x, 2, 1), "\x{F3}");
481 $x = "\x{101}\x{F2}\x{F3}";
482 substr($x, 1, 1) = "\x{100}\xFF";
484 is($x, "\x{101}\x{100}\xFF\xF3");
485 is(substr($x, 0, 1), "\x{101}");
486 is(substr($x, 1, 1), "\x{100}");
487 is(substr($x, 2, 1), "\x{FF}");
488 is(substr($x, 3, 1), "\x{F3}");
490 $x = "\x{101}\x{F2}\x{F3}";
491 substr($x, 2, 1) = "\x{100}\xFF";
493 is($x, "\x{101}\xF2\x{100}\xFF");
494 is(substr($x, 0, 1), "\x{101}");
495 is(substr($x, 1, 1), "\x{F2}");
496 is(substr($x, 2, 1), "\x{100}");
497 is(substr($x, 3, 1), "\x{FF}");
499 $x = "\x{101}\x{F2}\x{F3}";
500 substr($x, 3, 1) = "\x{100}\xFF";
502 is($x, "\x{101}\x{F2}\x{F3}\x{100}\xFF");
503 is(substr($x, 0, 1), "\x{101}");
504 is(substr($x, 1, 1), "\x{F2}");
505 is(substr($x, 2, 1), "\x{F3}");
506 is(substr($x, 3, 1), "\x{100}");
507 is(substr($x, 4, 1), "\x{FF}");
509 $x = "\x{101}\x{F2}\x{F3}";
510 substr($x, -1, 1) = "\x{100}\xFF";
512 is($x, "\x{101}\xF2\x{100}\xFF");
513 is(substr($x, 0, 1), "\x{101}");
514 is(substr($x, 1, 1), "\x{F2}");
515 is(substr($x, 2, 1), "\x{100}");
516 is(substr($x, 3, 1), "\x{FF}");
518 $x = "\x{101}\x{F2}\x{F3}";
519 substr($x, -1, 0) = "\x{100}\xFF";
521 is($x, "\x{101}\xF2\x{100}\xFF\xF3");
522 is(substr($x, 0, 1), "\x{101}");
523 is(substr($x, 1, 1), "\x{F2}");
524 is(substr($x, 2, 1), "\x{100}");
525 is(substr($x, 3, 1), "\x{FF}");
526 is(substr($x, 4, 1), "\x{F3}");
528 $x = "\x{101}\x{F2}\x{F3}";
529 substr($x, 0, -1) = "\x{100}\xFF";
531 is($x, "\x{100}\xFF\xF3");
532 is(substr($x, 0, 1), "\x{100}");
533 is(substr($x, 1, 1), "\x{FF}");
534 is(substr($x, 2, 1), "\x{F3}");
536 $x = "\x{101}\x{F2}\x{F3}";
537 substr($x, 0, -2) = "\x{100}\xFF";
539 is($x, "\x{100}\xFF\xF2\xF3");
540 is(substr($x, 0, 1), "\x{100}");
541 is(substr($x, 1, 1), "\x{FF}");
542 is(substr($x, 2, 1), "\x{F2}");
543 is(substr($x, 3, 1), "\x{F3}");
545 $x = "\x{101}\x{F2}\x{F3}";
546 substr($x, 0, -3) = "\x{100}\xFF";
548 is($x, "\x{100}\xFF\x{101}\x{F2}\x{F3}");
549 is(substr($x, 0, 1), "\x{100}");
550 is(substr($x, 1, 1), "\x{FF}");
551 is(substr($x, 2, 1), "\x{101}");
552 is(substr($x, 3, 1), "\x{F2}");
553 is(substr($x, 4, 1), "\x{F3}");
555 $x = "\x{101}\x{F2}\x{F3}";
556 substr($x, 1, -1) = "\x{100}\xFF";
558 is($x, "\x{101}\x{100}\xFF\xF3");
559 is(substr($x, 0, 1), "\x{101}");
560 is(substr($x, 1, 1), "\x{100}");
561 is(substr($x, 2, 1), "\x{FF}");
562 is(substr($x, 3, 1), "\x{F3}");
564 $x = "\x{101}\x{F2}\x{F3}";
565 substr($x, -1, -1) = "\x{100}\xFF";
567 is($x, "\x{101}\xF2\x{100}\xFF\xF3");
568 is(substr($x, 0, 1), "\x{101}");
569 is(substr($x, 1, 1), "\x{F2}");
570 is(substr($x, 2, 1), "\x{100}");
571 is(substr($x, 3, 1), "\x{FF}");
572 is(substr($x, 4, 1), "\x{F3}");
574 substr($x = "ab", 0, 0, "\x{100}\x{200}");
575 is($x, "\x{100}\x{200}ab");
577 substr($x = "\x{100}\x{200}", 0, 0, "ab");
578 is($x, "ab\x{100}\x{200}");
580 substr($x = "ab", 1, 0, "\x{100}\x{200}");
581 is($x, "a\x{100}\x{200}b");
583 substr($x = "\x{100}\x{200}", 1, 0, "ab");
584 is($x, "\x{100}ab\x{200}");
586 substr($x = "ab", 2, 0, "\x{100}\x{200}");
587 is($x, "ab\x{100}\x{200}");
589 substr($x = "\x{100}\x{200}", 2, 0, "ab");
590 is($x, "\x{100}\x{200}ab");
592 substr($x = "\xFFb", 0, 0, "\x{100}\x{200}");
593 is($x, "\x{100}\x{200}\xFFb");
595 substr($x = "\x{100}\x{200}", 0, 0, "\xFFb");
596 is($x, "\xFFb\x{100}\x{200}");
598 substr($x = "\xFFb", 1, 0, "\x{100}\x{200}");
599 is($x, "\xFF\x{100}\x{200}b");
601 substr($x = "\x{100}\x{200}", 1, 0, "\xFFb");
602 is($x, "\x{100}\xFFb\x{200}");
604 substr($x = "\xFFb", 2, 0, "\x{100}\x{200}");
605 is($x, "\xFFb\x{100}\x{200}");
607 substr($x = "\x{100}\x{200}", 2, 0, "\xFFb");
608 is($x, "\x{100}\x{200}\xFFb");
614 $r[$_] = \ substr $s, $_, 1 for (0, 1);
615 is(join("", map { $$_ } @r), "ab");
621 substr($_[0],0,1) ^= substr($_[0],1,1) ^=
622 substr($_[0],0,1) ^= substr($_[0],1,1);
624 my $x = my $y = 'AB'; ss $x; ss $y;
630 my $x = "0123456789\x{500}";
631 my $y = substr $x, 4;
632 is(substr($x, 7, 1), "7");
635 # multiple assignments to lvalue [perl #24346]
638 for (substr($x,1,3)) {
646 $_ = "\xF1\xF2\xF3\xF4\xF5\xF6";
647 is($_, "\xF1\xF2\xF3\xF4\xF5\xF6");
648 is($x, "a\xF1\xF2\xF3\xF4\xF5\xF6ef");
655 # [perl #24200] string corruption with lvalue sub
658 sub bar: lvalue { substr $krunch, 0 }
661 $krunch = '123456789';
662 is(bar, '123456789');
667 my $text = "0123456789\xED ";
668 utf8::upgrade($text);
671 my $a = substr($text, $pos, $pos);
672 is(substr($text,$pos,1), $pos);
678 my $a = pack("C", 0xbf);
679 substr($a, -1) &= chr(0xfeff);
683 # [perl #34976] incorrect caching of utf8 substr length
685 my $a = "abcd\x{100}";
686 is(substr($a,1,2), 'bc');
687 is(substr($a,1,1), 'b');
690 # [perl #62646] offsets exceeding 32 bits on 64-bit system
692 skip("32-bit system", 24) unless ~0 > 0xffffffff;
700 $r = substr($a, 0xffffffff, 1);
705 $r = substr($a, 0xffffffff+1, 1);
710 ok( !eval { $r = substr($s=$a, 0xffffffff, 1, "_"); 1 } );
716 ok( !eval { $r = substr($s=$a, 0xffffffff+1, 1, "_"); 1 } );