This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Move a test to the right file
[perl5.git] / t / re / substr.t
1 #!./perl
2
3 #P = start of string  Q = start of substr  R = end of substr  S = end of string
4
5 BEGIN {
6     chdir 't' if -d 't';
7     @INC = '../lib';
8 }
9 use warnings ;
10 no warnings 'deprecated';
11
12 $a = 'abcdefxyz';
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;
18      } elsif ($_[0] =~ /^Use of uninitialized value/) {
19           $w += 3;
20      } else {
21           warn $_[0];
22      }
23 };
24
25 BEGIN { require './test.pl'; }
26
27 plan(363);
28
29 run_tests() unless caller;
30
31 my $krunch = "a";
32
33 sub run_tests {
34
35 $FATAL_MSG = qr/^substr outside of string/;
36
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
41 is ($w--, 1);
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
46
47 $[ = 1;
48
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
53 is($w--, 1);
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
58
59 $[ = 0;
60
61 substr($a,3,3) = 'XYZ';
62 is($a, 'abcXYZxyz' );
63 substr($a,0,2) = '';
64 is($a, 'cXYZxyz' );
65 substr($a,0,0) = 'ab';
66 is($a, 'abcXYZxyz' );
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' );
75
76 $a = 'abcdefxyz';
77
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
81 is($w--, 1);
82 eval{substr($a,999,999) = "" ; } ;    # P R=S Q
83 like($@, $FATAL_MSG);
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
88
89 $a = '54321';
90
91 $b = substr($a,-7, 1) ; # warn  # Q R P S
92 is($w--, 1);
93 eval{substr($a,-7, 1) = "" ; }; # Q R P S
94 like($@, $FATAL_MSG);
95 $b = substr($a,-7,-6) ; # warn  # Q R P S
96 is($w--, 1);
97 eval{substr($a,-7,-6) = "" ; }; # Q R P S
98 like($@, $FATAL_MSG);
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
110 is($w--, 1);
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
114 is($w--, 1);
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
118 is($w--, 1);
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
122 is($w--, 1);
123 eval{substr($a, 7, 0) = "" ; }; # P S Q=R
124 like($@, $FATAL_MSG);
125
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
152
153 $a = '';
154
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
161
162
163 is(substr($a,0,-1), '');   # R P=Q=S
164 $b = substr($a,-2, 0) ; # warn  # Q=R P=S
165 is($w--, 1);
166 eval{substr($a,-2, 0) = "" ; }; # Q=R P=S
167 like($@, $FATAL_MSG);
168
169 $b = substr($a,-2, 1) ; # warn  # Q R P=S
170 is($w--, 1);
171 eval{substr($a,-2, 1) = "" ; }; # Q R P=S
172 like($@, $FATAL_MSG);
173
174 $b = substr($a,-2,-1) ; # warn  # Q R P=S
175 is($w--, 1);
176 eval{substr($a,-2,-1) = "" ; }; # Q R P=S
177 like($@, $FATAL_MSG);
178
179 $b = substr($a,-2,-2) ; # warn  # Q=R P=S
180 is($w--, 1);
181 eval{substr($a,-2,-2) = "" ; }; # Q=R P=S
182 like($@, $FATAL_MSG);
183
184 $b = substr($a, 1,-2) ; # warn  # R P=S Q
185 is($w--, 1);
186 eval{substr($a, 1,-2) = "" ; }; # R P=S Q
187 like($@, $FATAL_MSG);
188
189 $b = substr($a, 1, 1) ; # warn  # P=S Q R
190 is($w--, 1);
191 eval{substr($a, 1, 1) = "" ; }; # P=S Q R
192 like($@, $FATAL_MSG);
193
194 $b = substr($a, 1, 0) ;# warn   # P=S Q=R
195 is($w--, 1);
196 eval{substr($a, 1, 0) = "" ; }; # P=S Q=R
197 like($@, $FATAL_MSG);
198
199 $b = substr($a,1) ; # warning   # P=R=S Q
200 is($w--, 1);
201 eval{substr($a,1) = "" ; };     # P=R=S Q
202 like($@, $FATAL_MSG);
203
204 $b = substr($a,-7,-6) ; # warn  # Q R P S
205 is($w--, 1);
206 eval{substr($a,-7,-6) = "" ; }; # Q R P S
207 like($@, $FATAL_MSG);
208
209 my $a = 'zxcvbnm';
210 substr($a,2,0) = '';
211 is($a, 'zxcvbnm');
212 substr($a,7,0) = '';
213 is($a, 'zxcvbnm');
214 substr($a,5,0) = '';
215 is($a, 'zxcvbnm');
216 substr($a,0,2) = 'pq';
217 is($a, 'pqcvbnm');
218 substr($a,2,0) = 'r';
219 is($a, 'pqrcvbnm');
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';
227 is($a, 'fghjklsd');
228 substr($a,3,2) = '1234';
229 is($a, 'fgh1234lsd');
230
231
232 # with lexicals (and in re-entered scopes)
233 for (0,1) {
234   my $txt;
235   unless ($_) {
236     $txt = "Foo";
237     substr($txt, -1) = "X";
238     is($txt, "FoX");
239   }
240   else {
241     substr($txt, 0, 1) = "X";
242     is($txt, "X");
243   }
244 }
245
246 $w = 0 ;
247 # coercion of references
248 {
249   my $s = [];
250   substr($s, 0, 1) = 'Foo';
251   is (substr($s,0,7), "FooRRAY");
252   is ($w,2);
253   $w = 0;
254 }
255
256 # check no spurious warnings
257 is($w, 0);
258
259 # check new 4 arg replacement syntax
260 $a = "abcxyz";
261 $w = 0;
262 is(substr($a, 0, 3, ""), "abc");
263 is($a, "xyz");
264 is(substr($a, 0, 0, "abc"), "");
265 is($a, "abcxyz");
266 is(substr($a, 3, -1, ""), "xy");
267 is($a, "abcz");
268
269 is(substr($a, 3, undef, "xy"), "");
270 is($a, "abcxyz");
271 is($w, 3);
272
273 $w = 0;
274
275 is(substr($a, 3, 9999999, ""), "xyz");
276 is($a, "abc");
277 eval{substr($a, -99, 0, "") };
278 like($@, $FATAL_MSG);
279 eval{substr($a, 99, 3, "") };
280 like($@, $FATAL_MSG);
281
282 substr($a, 0, length($a), "foo");
283 is ($a, "foo");
284 is ($w, 0);
285
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/);
289 is ($a, "foo");
290
291 $a = "abcdefgh";
292 is(sub { shift }->(substr($a, 0, 4, "xxxx")), 'abcd');
293 is($a, 'xxxxefgh');
294
295 {
296     my $y = 10;
297     $y = "2" . $y;
298     is ($y, 210);
299 }
300
301 # utf8 sanity
302 {
303     my $x = substr("a\x{263a}b",0);
304     is(length($x), 3);
305     $x = substr($x,1,1);
306     is($x, "\x{263a}");
307     $x = $x x 2;
308     is(length($x), 2);
309     substr($x,0,1) = "abcd";
310     is($x, "abcd\x{263a}");
311     is(length($x), 5);
312     $x = reverse $x;
313     is(length($x), 5);
314     is($x, "\x{263a}dcba");
315
316     my $z = 10;
317     $z = "21\x{263a}" . $z;
318     is(length($z), 5);
319     is($z, "21\x{263a}10");
320 }
321
322 # replacement should work on magical values
323 require Tie::Scalar;
324 my %data;
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");
329
330 # more utf8
331
332 # The following two originally from Ignasi Roca.
333
334 $x = "\xF1\xF2\xF3";
335 substr($x, 0, 1) = "\x{100}"; # Ignasi had \x{FF}
336 is(length($x), 3);
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}");
341
342 $x = "\xF1\xF2\xF3";
343 substr($x, 0, 1) = "\x{100}\x{FF}"; # Ignasi had \x{FF}
344 is(length($x), 4);
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}");
350
351 # more utf8 lval exercise
352
353 $x = "\xF1\xF2\xF3";
354 substr($x, 0, 2) = "\x{100}\xFF";
355 is(length($x), 3);
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}");
360
361 $x = "\xF1\xF2\xF3";
362 substr($x, 1, 1) = "\x{100}\xFF";
363 is(length($x), 4);
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}");
369
370 $x = "\xF1\xF2\xF3";
371 substr($x, 2, 1) = "\x{100}\xFF";
372 is(length($x), 4);
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}");
378
379 $x = "\xF1\xF2\xF3";
380 substr($x, 3, 1) = "\x{100}\xFF";
381 is(length($x), 5);
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}");
388
389 $x = "\xF1\xF2\xF3";
390 substr($x, -1, 1) = "\x{100}\xFF";
391 is(length($x), 4);
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}");
397
398 $x = "\xF1\xF2\xF3";
399 substr($x, -1, 0) = "\x{100}\xFF";
400 is(length($x), 5);
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}");
407
408 $x = "\xF1\xF2\xF3";
409 substr($x, 0, -1) = "\x{100}\xFF";
410 is(length($x), 3);
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}");
415
416 $x = "\xF1\xF2\xF3";
417 substr($x, 0, -2) = "\x{100}\xFF";
418 is(length($x), 4);
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}");
424
425 $x = "\xF1\xF2\xF3";
426 substr($x, 0, -3) = "\x{100}\xFF";
427 is(length($x), 5);
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}");
434
435 $x = "\xF1\xF2\xF3";
436 substr($x, 1, -1) = "\x{100}\xFF";
437 is(length($x), 4);
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}");
443
444 $x = "\xF1\xF2\xF3";
445 substr($x, -1, -1) = "\x{100}\xFF";
446 is(length($x), 5);
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}");
453
454 # And tests for already-UTF8 one
455
456 $x = "\x{101}\x{F2}\x{F3}";
457 substr($x, 0, 1) = "\x{100}";
458 is(length($x), 3);
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}");
463
464 $x = "\x{101}\x{F2}\x{F3}";
465 substr($x, 0, 1) = "\x{100}\x{FF}";
466 is(length($x), 4);
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}");
472
473 $x = "\x{101}\x{F2}\x{F3}";
474 substr($x, 0, 2) = "\x{100}\xFF";
475 is(length($x), 3);
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}");
480
481 $x = "\x{101}\x{F2}\x{F3}";
482 substr($x, 1, 1) = "\x{100}\xFF";
483 is(length($x), 4);
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}");
489
490 $x = "\x{101}\x{F2}\x{F3}";
491 substr($x, 2, 1) = "\x{100}\xFF";
492 is(length($x), 4);
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}");
498
499 $x = "\x{101}\x{F2}\x{F3}";
500 substr($x, 3, 1) = "\x{100}\xFF";
501 is(length($x), 5);
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}");
508
509 $x = "\x{101}\x{F2}\x{F3}";
510 substr($x, -1, 1) = "\x{100}\xFF";
511 is(length($x), 4);
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}");
517
518 $x = "\x{101}\x{F2}\x{F3}";
519 substr($x, -1, 0) = "\x{100}\xFF";
520 is(length($x), 5);
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}");
527
528 $x = "\x{101}\x{F2}\x{F3}";
529 substr($x, 0, -1) = "\x{100}\xFF";
530 is(length($x), 3);
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}");
535
536 $x = "\x{101}\x{F2}\x{F3}";
537 substr($x, 0, -2) = "\x{100}\xFF";
538 is(length($x), 4);
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}");
544
545 $x = "\x{101}\x{F2}\x{F3}";
546 substr($x, 0, -3) = "\x{100}\xFF";
547 is(length($x), 5);
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}");
554
555 $x = "\x{101}\x{F2}\x{F3}";
556 substr($x, 1, -1) = "\x{100}\xFF";
557 is(length($x), 4);
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}");
563
564 $x = "\x{101}\x{F2}\x{F3}";
565 substr($x, -1, -1) = "\x{100}\xFF";
566 is(length($x), 5);
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}");
573
574 substr($x = "ab", 0, 0, "\x{100}\x{200}");
575 is($x, "\x{100}\x{200}ab");
576
577 substr($x = "\x{100}\x{200}", 0, 0, "ab");
578 is($x, "ab\x{100}\x{200}");
579
580 substr($x = "ab", 1, 0, "\x{100}\x{200}");
581 is($x, "a\x{100}\x{200}b");
582
583 substr($x = "\x{100}\x{200}", 1, 0, "ab");
584 is($x, "\x{100}ab\x{200}");
585
586 substr($x = "ab", 2, 0, "\x{100}\x{200}");
587 is($x, "ab\x{100}\x{200}");
588
589 substr($x = "\x{100}\x{200}", 2, 0, "ab");
590 is($x, "\x{100}\x{200}ab");
591
592 substr($x = "\xFFb", 0, 0, "\x{100}\x{200}");
593 is($x, "\x{100}\x{200}\xFFb");
594
595 substr($x = "\x{100}\x{200}", 0, 0, "\xFFb");
596 is($x, "\xFFb\x{100}\x{200}");
597
598 substr($x = "\xFFb", 1, 0, "\x{100}\x{200}");
599 is($x, "\xFF\x{100}\x{200}b");
600
601 substr($x = "\x{100}\x{200}", 1, 0, "\xFFb");
602 is($x, "\x{100}\xFFb\x{200}");
603
604 substr($x = "\xFFb", 2, 0, "\x{100}\x{200}");
605 is($x, "\xFFb\x{100}\x{200}");
606
607 substr($x = "\x{100}\x{200}", 2, 0, "\xFFb");
608 is($x, "\x{100}\x{200}\xFFb");
609
610 # [perl #20933]
611
612     my $s = "ab";
613     my @r; 
614     $r[$_] = \ substr $s, $_, 1 for (0, 1);
615     is(join("", map { $$_ } @r), "ab");
616 }
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;
625     is($x, $y);
626 }
627
628 # [perl #24605]
629 {
630     my $x = "0123456789\x{500}";
631     my $y = substr $x, 4;
632     is(substr($x, 7, 1), "7");
633 }
634
635 # multiple assignments to lvalue [perl #24346]   
636 {
637     my $x = "abcdef";
638     for (substr($x,1,3)) {
639         is($_, 'bcd');
640         $_ = 'XX';
641         is($_, 'XX');
642         is($x, 'aXXef'); 
643         $_ = "\xFF";
644         is($_, "\xFF"); 
645         is($x, "a\xFFef");
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"); 
649         $_ = 'YYYY';
650         is($_, 'YYYY'); 
651         is($x, 'aYYYYef');
652     }
653 }
654
655 # [perl #24200] string corruption with lvalue sub
656
657 {
658     sub bar: lvalue { substr $krunch, 0 }
659     bar = "XXX";
660     is(bar, 'XXX');
661     $krunch = '123456789';
662     is(bar, '123456789');
663 }
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);
672     is(substr($text,$pos,1), $pos);
673
674 }
675
676 # [perl #23765]
677 {
678     my $a = pack("C", 0xbf);
679     substr($a, -1) &= chr(0xfeff);
680     is($a, "\xbf");
681 }
682
683 # [perl #34976] incorrect caching of utf8 substr length
684 {
685     my  $a = "abcd\x{100}";
686     is(substr($a,1,2), 'bc');
687     is(substr($a,1,1), 'b');
688 }
689
690 # [perl #62646] offsets exceeding 32 bits on 64-bit system
691 SKIP: {
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
725 }
726
727
728 my $destroyed;
729 { package Class; DESTROY { ++$destroyed; } }
730
731 $destroyed = 0;
732 {
733     my $x = '';
734     substr($x,0,1) = "";
735     $x = bless({}, 'Class');
736 }
737 is($destroyed, 1, 'Timely scalar destruction with lvalue substr');
738
739 # [perl #77692] UTF8 cache not being reset when TARG is reused
740 ok eval {
741  local ${^UTF8CACHE} = -1;
742  for my $i (0..1)
743  {
744    my $dummy = length(substr("\x{100}",0,$i));
745  }
746  1
747 }, 'UTF8 cache is reset when TARG is reused [perl #77692]';
748
749 {
750     my $result_3363;
751     sub a_3363 {
752         my ($word, $replace) = @_;
753         my $ref = \substr($word, 0, 1);
754         $$ref = $replace;
755         if ($replace eq "b") {
756             $result_3363 = $word;
757         } else {
758             a_3363($word, "b");
759         }
760     }
761     a_3363($_, "v") for "test";
762
763     is($result_3363, "best", "ref-to-substr retains lvalue-ness under recursion [perl #3363]");
764 }