This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Variants of several regression tests that run the actul tests inside
[perl5.git] / t / op / substr.t
1 #!./perl -w
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
11 $a = 'abcdefxyz';
12 $SIG{__WARN__} = sub {
13      if ($_[0] =~ /^substr outside of string/) {
14           $w++;
15      } elsif ($_[0] =~ /^Attempt to use reference as lvalue in substr/) {
16           $w += 2;
17      } elsif ($_[0] =~ /^Use of uninitialized value/) {
18           $w += 3;
19      } else {
20           warn $_[0];
21      }
22 };
23
24 require './test.pl';
25
26 plan(334);
27
28 run_tests() unless caller;
29
30 my $krunch = "a";
31
32 sub run_tests {
33
34 $FATAL_MSG = qr/^substr outside of string/;
35
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
40 is ($w--, 1);
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
45
46 $[ = 1;
47
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
52 is($w--, 1);
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
57
58 $[ = 0;
59
60 substr($a,3,3) = 'XYZ';
61 is($a, 'abcXYZxyz' );
62 substr($a,0,2) = '';
63 is($a, 'cXYZxyz' );
64 substr($a,0,0) = 'ab';
65 is($a, 'abcXYZxyz' );
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' );
74
75 $a = 'abcdefxyz';
76
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
80 is($w--, 1);
81 eval{substr($a,999,999) = "" ; } ;    # P R=S Q
82 like($@, $FATAL_MSG);
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
87
88 $a = '54321';
89
90 $b = substr($a,-7, 1) ; # warn  # Q R P S
91 is($w--, 1);
92 eval{substr($a,-7, 1) = "" ; }; # Q R P S
93 like($@, $FATAL_MSG);
94 $b = substr($a,-7,-6) ; # warn  # Q R P S
95 is($w--, 1);
96 eval{substr($a,-7,-6) = "" ; }; # Q R P S
97 like($@, $FATAL_MSG);
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
109 is($w--, 1);
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
113 is($w--, 1);
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
117 is($w--, 1);
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
121 is($w--, 1);
122 eval{substr($a, 7, 0) = "" ; }; # P S Q=R
123 like($@, $FATAL_MSG);
124
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
151
152 $a = '';
153
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
160
161
162 is(substr($a,0,-1), '');   # R P=Q=S
163 $b = substr($a,-2, 0) ; # warn  # Q=R P=S
164 is($w--, 1);
165 eval{substr($a,-2, 0) = "" ; }; # Q=R P=S
166 like($@, $FATAL_MSG);
167
168 $b = substr($a,-2, 1) ; # warn  # Q R P=S
169 is($w--, 1);
170 eval{substr($a,-2, 1) = "" ; }; # Q R P=S
171 like($@, $FATAL_MSG);
172
173 $b = substr($a,-2,-1) ; # warn  # Q R P=S
174 is($w--, 1);
175 eval{substr($a,-2,-1) = "" ; }; # Q R P=S
176 like($@, $FATAL_MSG);
177
178 $b = substr($a,-2,-2) ; # warn  # Q=R P=S
179 is($w--, 1);
180 eval{substr($a,-2,-2) = "" ; }; # Q=R P=S
181 like($@, $FATAL_MSG);
182
183 $b = substr($a, 1,-2) ; # warn  # R P=S Q
184 is($w--, 1);
185 eval{substr($a, 1,-2) = "" ; }; # R P=S Q
186 like($@, $FATAL_MSG);
187
188 $b = substr($a, 1, 1) ; # warn  # P=S Q R
189 is($w--, 1);
190 eval{substr($a, 1, 1) = "" ; }; # P=S Q R
191 like($@, $FATAL_MSG);
192
193 $b = substr($a, 1, 0) ;# warn   # P=S Q=R
194 is($w--, 1);
195 eval{substr($a, 1, 0) = "" ; }; # P=S Q=R
196 like($@, $FATAL_MSG);
197
198 $b = substr($a,1) ; # warning   # P=R=S Q
199 is($w--, 1);
200 eval{substr($a,1) = "" ; };     # P=R=S Q
201 like($@, $FATAL_MSG);
202
203 my $a = 'zxcvbnm';
204 substr($a,2,0) = '';
205 is($a, 'zxcvbnm');
206 substr($a,7,0) = '';
207 is($a, 'zxcvbnm');
208 substr($a,5,0) = '';
209 is($a, 'zxcvbnm');
210 substr($a,0,2) = 'pq';
211 is($a, 'pqcvbnm');
212 substr($a,2,0) = 'r';
213 is($a, 'pqrcvbnm');
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';
221 is($a, 'fghjklsd');
222 substr($a,3,2) = '1234';
223 is($a, 'fgh1234lsd');
224
225
226 # with lexicals (and in re-entered scopes)
227 for (0,1) {
228   my $txt;
229   unless ($_) {
230     $txt = "Foo";
231     substr($txt, -1) = "X";
232     is($txt, "FoX");
233   }
234   else {
235     substr($txt, 0, 1) = "X";
236     is($txt, "X");
237   }
238 }
239
240 $w = 0 ;
241 # coercion of references
242 {
243   my $s = [];
244   substr($s, 0, 1) = 'Foo';
245   is (substr($s,0,7), "FooRRAY");
246   is ($w,2);
247   $w = 0;
248 }
249
250 # check no spurious warnings
251 is($w, 0);
252
253 # check new 4 arg replacement syntax
254 $a = "abcxyz";
255 $w = 0;
256 is(substr($a, 0, 3, ""), "abc");
257 is($a, "xyz");
258 is(substr($a, 0, 0, "abc"), "");
259 is($a, "abcxyz");
260 is(substr($a, 3, -1, ""), "xy");
261 is($a, "abcz");
262
263 is(substr($a, 3, undef, "xy"), "");
264 is($a, "abcxyz");
265 is($w, 3);
266
267 $w = 0;
268
269 is(substr($a, 3, 9999999, ""), "xyz");
270 is($a, "abc");
271 eval{substr($a, -99, 0, "") };
272 like($@, $FATAL_MSG);
273 eval{substr($a, 99, 3, "") };
274 like($@, $FATAL_MSG);
275
276 substr($a, 0, length($a), "foo");
277 is ($a, "foo");
278 is ($w, 0);
279
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/);
283 is ($a, "foo");
284
285 $a = "abcdefgh";
286 is(sub { shift }->(substr($a, 0, 4, "xxxx")), 'abcd');
287 is($a, 'xxxxefgh');
288
289 {
290     my $y = 10;
291     $y = "2" . $y;
292     is ($y, 210);
293 }
294
295 # utf8 sanity
296 {
297     my $x = substr("a\x{263a}b",0);
298     is(length($x), 3);
299     $x = substr($x,1,1);
300     is($x, "\x{263a}");
301     $x = $x x 2;
302     is(length($x), 2);
303     substr($x,0,1) = "abcd";
304     is($x, "abcd\x{263a}");
305     is(length($x), 5);
306     $x = reverse $x;
307     is(length($x), 5);
308     is($x, "\x{263a}dcba");
309
310     my $z = 10;
311     $z = "21\x{263a}" . $z;
312     is(length($z), 5);
313     is($z, "21\x{263a}10");
314 }
315
316 # replacement should work on magical values
317 require Tie::Scalar;
318 my %data;
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");
323
324 # more utf8
325
326 # The following two originally from Ignasi Roca.
327
328 $x = "\xF1\xF2\xF3";
329 substr($x, 0, 1) = "\x{100}"; # Ignasi had \x{FF}
330 is(length($x), 3);
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}");
335
336 $x = "\xF1\xF2\xF3";
337 substr($x, 0, 1) = "\x{100}\x{FF}"; # Ignasi had \x{FF}
338 is(length($x), 4);
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}");
344
345 # more utf8 lval exercise
346
347 $x = "\xF1\xF2\xF3";
348 substr($x, 0, 2) = "\x{100}\xFF";
349 is(length($x), 3);
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}");
354
355 $x = "\xF1\xF2\xF3";
356 substr($x, 1, 1) = "\x{100}\xFF";
357 is(length($x), 4);
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}");
363
364 $x = "\xF1\xF2\xF3";
365 substr($x, 2, 1) = "\x{100}\xFF";
366 is(length($x), 4);
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}");
372
373 $x = "\xF1\xF2\xF3";
374 substr($x, 3, 1) = "\x{100}\xFF";
375 is(length($x), 5);
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}");
382
383 $x = "\xF1\xF2\xF3";
384 substr($x, -1, 1) = "\x{100}\xFF";
385 is(length($x), 4);
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}");
391
392 $x = "\xF1\xF2\xF3";
393 substr($x, -1, 0) = "\x{100}\xFF";
394 is(length($x), 5);
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}");
401
402 $x = "\xF1\xF2\xF3";
403 substr($x, 0, -1) = "\x{100}\xFF";
404 is(length($x), 3);
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}");
409
410 $x = "\xF1\xF2\xF3";
411 substr($x, 0, -2) = "\x{100}\xFF";
412 is(length($x), 4);
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}");
418
419 $x = "\xF1\xF2\xF3";
420 substr($x, 0, -3) = "\x{100}\xFF";
421 is(length($x), 5);
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}");
428
429 $x = "\xF1\xF2\xF3";
430 substr($x, 1, -1) = "\x{100}\xFF";
431 is(length($x), 4);
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}");
437
438 $x = "\xF1\xF2\xF3";
439 substr($x, -1, -1) = "\x{100}\xFF";
440 is(length($x), 5);
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}");
447
448 # And tests for already-UTF8 one
449
450 $x = "\x{101}\x{F2}\x{F3}";
451 substr($x, 0, 1) = "\x{100}";
452 is(length($x), 3);
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}");
457
458 $x = "\x{101}\x{F2}\x{F3}";
459 substr($x, 0, 1) = "\x{100}\x{FF}";
460 is(length($x), 4);
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}");
466
467 $x = "\x{101}\x{F2}\x{F3}";
468 substr($x, 0, 2) = "\x{100}\xFF";
469 is(length($x), 3);
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}");
474
475 $x = "\x{101}\x{F2}\x{F3}";
476 substr($x, 1, 1) = "\x{100}\xFF";
477 is(length($x), 4);
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}");
483
484 $x = "\x{101}\x{F2}\x{F3}";
485 substr($x, 2, 1) = "\x{100}\xFF";
486 is(length($x), 4);
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}");
492
493 $x = "\x{101}\x{F2}\x{F3}";
494 substr($x, 3, 1) = "\x{100}\xFF";
495 is(length($x), 5);
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}");
502
503 $x = "\x{101}\x{F2}\x{F3}";
504 substr($x, -1, 1) = "\x{100}\xFF";
505 is(length($x), 4);
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}");
511
512 $x = "\x{101}\x{F2}\x{F3}";
513 substr($x, -1, 0) = "\x{100}\xFF";
514 is(length($x), 5);
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}");
521
522 $x = "\x{101}\x{F2}\x{F3}";
523 substr($x, 0, -1) = "\x{100}\xFF";
524 is(length($x), 3);
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}");
529
530 $x = "\x{101}\x{F2}\x{F3}";
531 substr($x, 0, -2) = "\x{100}\xFF";
532 is(length($x), 4);
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}");
538
539 $x = "\x{101}\x{F2}\x{F3}";
540 substr($x, 0, -3) = "\x{100}\xFF";
541 is(length($x), 5);
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}");
548
549 $x = "\x{101}\x{F2}\x{F3}";
550 substr($x, 1, -1) = "\x{100}\xFF";
551 is(length($x), 4);
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}");
557
558 $x = "\x{101}\x{F2}\x{F3}";
559 substr($x, -1, -1) = "\x{100}\xFF";
560 is(length($x), 5);
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}");
567
568 substr($x = "ab", 0, 0, "\x{100}\x{200}");
569 is($x, "\x{100}\x{200}ab");
570
571 substr($x = "\x{100}\x{200}", 0, 0, "ab");
572 is($x, "ab\x{100}\x{200}");
573
574 substr($x = "ab", 1, 0, "\x{100}\x{200}");
575 is($x, "a\x{100}\x{200}b");
576
577 substr($x = "\x{100}\x{200}", 1, 0, "ab");
578 is($x, "\x{100}ab\x{200}");
579
580 substr($x = "ab", 2, 0, "\x{100}\x{200}");
581 is($x, "ab\x{100}\x{200}");
582
583 substr($x = "\x{100}\x{200}", 2, 0, "ab");
584 is($x, "\x{100}\x{200}ab");
585
586 substr($x = "\xFFb", 0, 0, "\x{100}\x{200}");
587 is($x, "\x{100}\x{200}\xFFb");
588
589 substr($x = "\x{100}\x{200}", 0, 0, "\xFFb");
590 is($x, "\xFFb\x{100}\x{200}");
591
592 substr($x = "\xFFb", 1, 0, "\x{100}\x{200}");
593 is($x, "\xFF\x{100}\x{200}b");
594
595 substr($x = "\x{100}\x{200}", 1, 0, "\xFFb");
596 is($x, "\x{100}\xFFb\x{200}");
597
598 substr($x = "\xFFb", 2, 0, "\x{100}\x{200}");
599 is($x, "\xFFb\x{100}\x{200}");
600
601 substr($x = "\x{100}\x{200}", 2, 0, "\xFFb");
602 is($x, "\x{100}\x{200}\xFFb");
603
604 # [perl #20933]
605
606     my $s = "ab";
607     my @r; 
608     $r[$_] = \ substr $s, $_, 1 for (0, 1);
609     is(join("", map { $$_ } @r), "ab");
610 }
611
612 # [perl #23207]
613 {
614     sub ss {
615         substr($_[0],0,1) ^= substr($_[0],1,1) ^=
616         substr($_[0],0,1) ^= substr($_[0],1,1);
617     }
618     my $x = my $y = 'AB'; ss $x; ss $y;
619     is($x, $y);
620 }
621
622 # [perl #24605]
623 {
624     my $x = "0123456789\x{500}";
625     my $y = substr $x, 4;
626     is(substr($x, 7, 1), "7");
627 }
628
629 # multiple assignments to lvalue [perl #24346]   
630 {
631     my $x = "abcdef";
632     for (substr($x,1,3)) {
633         is($_, 'bcd');
634         $_ = 'XX';
635         is($_, 'XX');
636         is($x, 'aXXef'); 
637         $_ = "\xFF";
638         is($_, "\xFF"); 
639         is($x, "a\xFFef");
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"); 
643         $_ = 'YYYY';
644         is($_, 'YYYY'); 
645         is($x, 'aYYYYef');
646     }
647 }
648
649 # [perl #24200] string corruption with lvalue sub
650
651 {
652     sub bar: lvalue { substr $krunch, 0 }
653     bar = "XXX";
654     is(bar, 'XXX');
655     $krunch = '123456789';
656     is(bar, '123456789');
657 }
658
659 # [perl #29149]
660 {
661     my $text  = "0123456789\xED ";
662     utf8::upgrade($text);
663     my $pos = 5;
664     pos($text) = $pos;
665     my $a = substr($text, $pos, $pos);
666     is(substr($text,$pos,1), $pos);
667
668 }
669
670 # [perl #23765]
671 {
672     my $a = pack("C", 0xbf);
673     substr($a, -1) &= chr(0xfeff);
674     is($a, "\xbf");
675 }
676
677 # [perl #34976] incorrect caching of utf8 substr length
678 {
679     my  $a = "abcd\x{100}";
680     is(substr($a,1,2), 'bc');
681     is(substr($a,1,1), 'b');
682 }
683
684 }