Small optimisations, by Brandon Black
[p5sagit/p5-mst-13.2.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 $FATAL_MSG = qr/^substr outside of string/;
29
30 is(substr($a,0,3), 'abc');   # P=Q R S
31 is(substr($a,3,3), 'def');   # P Q R S
32 is(substr($a,6,999), 'xyz'); # P Q S R
33 $b = substr($a,999,999) ; # warn # P R Q S
34 is ($w--, 1);
35 eval{substr($a,999,999) = "" ; };# P R Q S
36 like ($@, $FATAL_MSG);
37 is(substr($a,0,-6), 'abc');  # P=Q R S
38 is(substr($a,-3,1), 'x');    # P Q R S
39
40 $[ = 1;
41
42 is(substr($a,1,3), 'abc' );  # P=Q R S
43 is(substr($a,4,3), 'def' );  # P Q R S
44 is(substr($a,7,999), 'xyz');# P Q S R
45 $b = substr($a,999,999) ; # warn # P R Q S
46 is($w--, 1);
47 eval{substr($a,999,999) = "" ; } ; # P R Q S
48 like ($@, $FATAL_MSG);
49 is(substr($a,1,-6), 'abc' );# P=Q R S
50 is(substr($a,-3,1), 'x' );  # P Q R S
51
52 $[ = 0;
53
54 substr($a,3,3) = 'XYZ';
55 is($a, 'abcXYZxyz' );
56 substr($a,0,2) = '';
57 is($a, 'cXYZxyz' );
58 substr($a,0,0) = 'ab';
59 is($a, 'abcXYZxyz' );
60 substr($a,0,0) = '12345678';
61 is($a, '12345678abcXYZxyz' );
62 substr($a,-3,3) = 'def';
63 is($a, '12345678abcXYZdef');
64 substr($a,-3,3) = '<';
65 is($a, '12345678abcXYZ<' );
66 substr($a,-1,1) = '12345678';
67 is($a, '12345678abcXYZ12345678' );
68
69 $a = 'abcdefxyz';
70
71 is(substr($a,6), 'xyz' );        # P Q R=S
72 is(substr($a,-3), 'xyz' );       # P Q R=S
73 $b = substr($a,999,999) ; # warning   # P R=S Q
74 is($w--, 1);
75 eval{substr($a,999,999) = "" ; } ;    # P R=S Q
76 like($@, $FATAL_MSG);
77 is(substr($a,0), 'abcdefxyz');  # P=Q R=S
78 is(substr($a,9), '');           # P Q=R=S
79 is(substr($a,-11), 'abcdefxyz'); # Q P R=S
80 is(substr($a,-9), 'abcdefxyz');  # P=Q R=S
81
82 $a = '54321';
83
84 $b = substr($a,-7, 1) ; # warn  # Q R P S
85 is($w--, 1);
86 eval{substr($a,-7, 1) = "" ; }; # Q R P S
87 like($@, $FATAL_MSG);
88 $b = substr($a,-7,-6) ; # warn  # Q R P S
89 is($w--, 1);
90 eval{substr($a,-7,-6) = "" ; }; # Q R P S
91 like($@, $FATAL_MSG);
92 is(substr($a,-5,-7), '');  # R P=Q S
93 is(substr($a, 2,-7), '');  # R P Q S
94 is(substr($a,-3,-7), '');  # R P Q S
95 is(substr($a, 2,-5), '');  # P=R Q S
96 is(substr($a,-3,-5), '');  # P=R Q S
97 is(substr($a, 2,-4), '');  # P R Q S
98 is(substr($a,-3,-4), '');  # P R Q S
99 is(substr($a, 5,-6), '');  # R P Q=S
100 is(substr($a, 5,-5), '');  # P=R Q S
101 is(substr($a, 5,-3), '');  # P R Q=S
102 $b = substr($a, 7,-7) ; # warn  # R P S Q
103 is($w--, 1);
104 eval{substr($a, 7,-7) = "" ; }; # R P S Q
105 like($@, $FATAL_MSG);
106 $b = substr($a, 7,-5) ; # warn  # P=R S Q
107 is($w--, 1);
108 eval{substr($a, 7,-5) = "" ; }; # P=R S Q
109 like($@, $FATAL_MSG);
110 $b = substr($a, 7,-3) ; # warn  # P Q S Q
111 is($w--, 1);
112 eval{substr($a, 7,-3) = "" ; }; # P Q S Q
113 like($@, $FATAL_MSG);
114 $b = substr($a, 7, 0) ; # warn  # P S Q=R
115 is($w--, 1);
116 eval{substr($a, 7, 0) = "" ; }; # P S Q=R
117 like($@, $FATAL_MSG);
118
119 is(substr($a,-7,2), '');   # Q P=R S
120 is(substr($a,-7,4), '54'); # Q P R S
121 is(substr($a,-7,7), '54321');# Q P R=S
122 is(substr($a,-7,9), '54321');# Q P S R
123 is(substr($a,-5,0), '');   # P=Q=R S
124 is(substr($a,-5,3), '543');# P=Q R S
125 is(substr($a,-5,5), '54321');# P=Q R=S
126 is(substr($a,-5,7), '54321');# P=Q S R
127 is(substr($a,-3,0), '');   # P Q=R S
128 is(substr($a,-3,3), '321');# P Q R=S
129 is(substr($a,-2,3), '21'); # P Q S R
130 is(substr($a,0,-5), '');   # P=Q=R S
131 is(substr($a,2,-3), '');   # P Q=R S
132 is(substr($a,0,0), '');    # P=Q=R S
133 is(substr($a,0,5), '54321');# P=Q R=S
134 is(substr($a,0,7), '54321');# P=Q S R
135 is(substr($a,2,0), '');    # P Q=R S
136 is(substr($a,2,3), '321'); # P Q R=S
137 is(substr($a,5,0), '');    # P Q=R=S
138 is(substr($a,5,2), '');    # P Q=S R
139 is(substr($a,-7,-5), '');  # Q P=R S
140 is(substr($a,-7,-2), '543');# Q P R S
141 is(substr($a,-5,-5), '');  # P=Q=R S
142 is(substr($a,-5,-2), '543');# P=Q R S
143 is(substr($a,-3,-3), '');  # P Q=R S
144 is(substr($a,-3,-1), '32');# P Q R S
145
146 $a = '';
147
148 is(substr($a,-2,2), '');   # Q P=R=S
149 is(substr($a,0,0), '');    # P=Q=R=S
150 is(substr($a,0,1), '');    # P=Q=S R
151 is(substr($a,-2,3), '');   # Q P=S R
152 is(substr($a,-2), '');     # Q P=R=S
153 is(substr($a,0), '');      # P=Q=R=S
154
155
156 is(substr($a,0,-1), '');   # R P=Q=S
157 $b = substr($a,-2, 0) ; # warn  # Q=R P=S
158 is($w--, 1);
159 eval{substr($a,-2, 0) = "" ; }; # Q=R P=S
160 like($@, $FATAL_MSG);
161
162 $b = substr($a,-2, 1) ; # warn  # Q R P=S
163 is($w--, 1);
164 eval{substr($a,-2, 1) = "" ; }; # Q R P=S
165 like($@, $FATAL_MSG);
166
167 $b = substr($a,-2,-1) ; # warn  # Q R P=S
168 is($w--, 1);
169 eval{substr($a,-2,-1) = "" ; }; # Q R P=S
170 like($@, $FATAL_MSG);
171
172 $b = substr($a,-2,-2) ; # warn  # Q=R P=S
173 is($w--, 1);
174 eval{substr($a,-2,-2) = "" ; }; # Q=R P=S
175 like($@, $FATAL_MSG);
176
177 $b = substr($a, 1,-2) ; # warn  # R P=S Q
178 is($w--, 1);
179 eval{substr($a, 1,-2) = "" ; }; # R P=S Q
180 like($@, $FATAL_MSG);
181
182 $b = substr($a, 1, 1) ; # warn  # P=S Q R
183 is($w--, 1);
184 eval{substr($a, 1, 1) = "" ; }; # P=S Q R
185 like($@, $FATAL_MSG);
186
187 $b = substr($a, 1, 0) ;# warn   # P=S Q=R
188 is($w--, 1);
189 eval{substr($a, 1, 0) = "" ; }; # P=S Q=R
190 like($@, $FATAL_MSG);
191
192 $b = substr($a,1) ; # warning   # P=R=S Q
193 is($w--, 1);
194 eval{substr($a,1) = "" ; };     # P=R=S Q
195 like($@, $FATAL_MSG);
196
197 my $a = 'zxcvbnm';
198 substr($a,2,0) = '';
199 is($a, 'zxcvbnm');
200 substr($a,7,0) = '';
201 is($a, 'zxcvbnm');
202 substr($a,5,0) = '';
203 is($a, 'zxcvbnm');
204 substr($a,0,2) = 'pq';
205 is($a, 'pqcvbnm');
206 substr($a,2,0) = 'r';
207 is($a, 'pqrcvbnm');
208 substr($a,8,0) = 'asd';
209 is($a, 'pqrcvbnmasd');
210 substr($a,0,2) = 'iop';
211 is($a, 'ioprcvbnmasd');
212 substr($a,0,5) = 'fgh';
213 is($a, 'fghvbnmasd');
214 substr($a,3,5) = 'jkl';
215 is($a, 'fghjklsd');
216 substr($a,3,2) = '1234';
217 is($a, 'fgh1234lsd');
218
219
220 # with lexicals (and in re-entered scopes)
221 for (0,1) {
222   my $txt;
223   unless ($_) {
224     $txt = "Foo";
225     substr($txt, -1) = "X";
226     is($txt, "FoX");
227   }
228   else {
229     substr($txt, 0, 1) = "X";
230     is($txt, "X");
231   }
232 }
233
234 $w = 0 ;
235 # coercion of references
236 {
237   my $s = [];
238   substr($s, 0, 1) = 'Foo';
239   is (substr($s,0,7), "FooRRAY");
240   is ($w,2);
241   $w = 0;
242 }
243
244 # check no spurious warnings
245 is($w, 0);
246
247 # check new 4 arg replacement syntax
248 $a = "abcxyz";
249 $w = 0;
250 is(substr($a, 0, 3, ""), "abc");
251 is($a, "xyz");
252 is(substr($a, 0, 0, "abc"), "");
253 is($a, "abcxyz");
254 is(substr($a, 3, -1, ""), "xy");
255 is($a, "abcz");
256
257 is(substr($a, 3, undef, "xy"), "");
258 is($a, "abcxyz");
259 is($w, 3);
260
261 $w = 0;
262
263 is(substr($a, 3, 9999999, ""), "xyz");
264 is($a, "abc");
265 eval{substr($a, -99, 0, "") };
266 like($@, $FATAL_MSG);
267 eval{substr($a, 99, 3, "") };
268 like($@, $FATAL_MSG);
269
270 substr($a, 0, length($a), "foo");
271 is ($a, "foo");
272 is ($w, 0);
273
274 # using 4 arg substr as lvalue is a compile time error
275 eval 'substr($a,0,0,"") = "abc"';
276 like ($@, qr/Can't modify substr/);
277 is ($a, "foo");
278
279 $a = "abcdefgh";
280 is(sub { shift }->(substr($a, 0, 4, "xxxx")), 'abcd');
281 is($a, 'xxxxefgh');
282
283 {
284     my $y = 10;
285     $y = "2" . $y;
286     is ($y, 210);
287 }
288
289 # utf8 sanity
290 {
291     my $x = substr("a\x{263a}b",0);
292     is(length($x), 3);
293     $x = substr($x,1,1);
294     is($x, "\x{263a}");
295     $x = $x x 2;
296     is(length($x), 2);
297     substr($x,0,1) = "abcd";
298     is($x, "abcd\x{263a}");
299     is(length($x), 5);
300     $x = reverse $x;
301     is(length($x), 5);
302     is($x, "\x{263a}dcba");
303
304     my $z = 10;
305     $z = "21\x{263a}" . $z;
306     is(length($z), 5);
307     is($z, "21\x{263a}10");
308 }
309
310 # replacement should work on magical values
311 require Tie::Scalar;
312 my %data;
313 tie $data{'a'}, 'Tie::StdScalar';  # makes $data{'a'} magical
314 $data{a} = "firstlast";
315 is(substr($data{'a'}, 0, 5, ""), "first");
316 is($data{'a'}, "last");
317
318 # more utf8
319
320 # The following two originally from Ignasi Roca.
321
322 $x = "\xF1\xF2\xF3";
323 substr($x, 0, 1) = "\x{100}"; # Ignasi had \x{FF}
324 is(length($x), 3);
325 is($x, "\x{100}\xF2\xF3");
326 is(substr($x, 0, 1), "\x{100}");
327 is(substr($x, 1, 1), "\x{F2}");
328 is(substr($x, 2, 1), "\x{F3}");
329
330 $x = "\xF1\xF2\xF3";
331 substr($x, 0, 1) = "\x{100}\x{FF}"; # Ignasi had \x{FF}
332 is(length($x), 4);
333 is($x, "\x{100}\x{FF}\xF2\xF3");
334 is(substr($x, 0, 1), "\x{100}");
335 is(substr($x, 1, 1), "\x{FF}");
336 is(substr($x, 2, 1), "\x{F2}");
337 is(substr($x, 3, 1), "\x{F3}");
338
339 # more utf8 lval exercise
340
341 $x = "\xF1\xF2\xF3";
342 substr($x, 0, 2) = "\x{100}\xFF";
343 is(length($x), 3);
344 is($x, "\x{100}\xFF\xF3");
345 is(substr($x, 0, 1), "\x{100}");
346 is(substr($x, 1, 1), "\x{FF}");
347 is(substr($x, 2, 1), "\x{F3}");
348
349 $x = "\xF1\xF2\xF3";
350 substr($x, 1, 1) = "\x{100}\xFF";
351 is(length($x), 4);
352 is($x, "\xF1\x{100}\xFF\xF3");
353 is(substr($x, 0, 1), "\x{F1}");
354 is(substr($x, 1, 1), "\x{100}");
355 is(substr($x, 2, 1), "\x{FF}");
356 is(substr($x, 3, 1), "\x{F3}");
357
358 $x = "\xF1\xF2\xF3";
359 substr($x, 2, 1) = "\x{100}\xFF";
360 is(length($x), 4);
361 is($x, "\xF1\xF2\x{100}\xFF");
362 is(substr($x, 0, 1), "\x{F1}");
363 is(substr($x, 1, 1), "\x{F2}");
364 is(substr($x, 2, 1), "\x{100}");
365 is(substr($x, 3, 1), "\x{FF}");
366
367 $x = "\xF1\xF2\xF3";
368 substr($x, 3, 1) = "\x{100}\xFF";
369 is(length($x), 5);
370 is($x, "\xF1\xF2\xF3\x{100}\xFF");
371 is(substr($x, 0, 1), "\x{F1}");
372 is(substr($x, 1, 1), "\x{F2}");
373 is(substr($x, 2, 1), "\x{F3}");
374 is(substr($x, 3, 1), "\x{100}");
375 is(substr($x, 4, 1), "\x{FF}");
376
377 $x = "\xF1\xF2\xF3";
378 substr($x, -1, 1) = "\x{100}\xFF";
379 is(length($x), 4);
380 is($x, "\xF1\xF2\x{100}\xFF");
381 is(substr($x, 0, 1), "\x{F1}");
382 is(substr($x, 1, 1), "\x{F2}");
383 is(substr($x, 2, 1), "\x{100}");
384 is(substr($x, 3, 1), "\x{FF}");
385
386 $x = "\xF1\xF2\xF3";
387 substr($x, -1, 0) = "\x{100}\xFF";
388 is(length($x), 5);
389 is($x, "\xF1\xF2\x{100}\xFF\xF3");
390 is(substr($x, 0, 1), "\x{F1}");
391 is(substr($x, 1, 1), "\x{F2}");
392 is(substr($x, 2, 1), "\x{100}");
393 is(substr($x, 3, 1), "\x{FF}");
394 is(substr($x, 4, 1), "\x{F3}");
395
396 $x = "\xF1\xF2\xF3";
397 substr($x, 0, -1) = "\x{100}\xFF";
398 is(length($x), 3);
399 is($x, "\x{100}\xFF\xF3");
400 is(substr($x, 0, 1), "\x{100}");
401 is(substr($x, 1, 1), "\x{FF}");
402 is(substr($x, 2, 1), "\x{F3}");
403
404 $x = "\xF1\xF2\xF3";
405 substr($x, 0, -2) = "\x{100}\xFF";
406 is(length($x), 4);
407 is($x, "\x{100}\xFF\xF2\xF3");
408 is(substr($x, 0, 1), "\x{100}");
409 is(substr($x, 1, 1), "\x{FF}");
410 is(substr($x, 2, 1), "\x{F2}");
411 is(substr($x, 3, 1), "\x{F3}");
412
413 $x = "\xF1\xF2\xF3";
414 substr($x, 0, -3) = "\x{100}\xFF";
415 is(length($x), 5);
416 is($x, "\x{100}\xFF\xF1\xF2\xF3");
417 is(substr($x, 0, 1), "\x{100}");
418 is(substr($x, 1, 1), "\x{FF}");
419 is(substr($x, 2, 1), "\x{F1}");
420 is(substr($x, 3, 1), "\x{F2}");
421 is(substr($x, 4, 1), "\x{F3}");
422
423 $x = "\xF1\xF2\xF3";
424 substr($x, 1, -1) = "\x{100}\xFF";
425 is(length($x), 4);
426 is($x, "\xF1\x{100}\xFF\xF3");
427 is(substr($x, 0, 1), "\x{F1}");
428 is(substr($x, 1, 1), "\x{100}");
429 is(substr($x, 2, 1), "\x{FF}");
430 is(substr($x, 3, 1), "\x{F3}");
431
432 $x = "\xF1\xF2\xF3";
433 substr($x, -1, -1) = "\x{100}\xFF";
434 is(length($x), 5);
435 is($x, "\xF1\xF2\x{100}\xFF\xF3");
436 is(substr($x, 0, 1), "\x{F1}");
437 is(substr($x, 1, 1), "\x{F2}");
438 is(substr($x, 2, 1), "\x{100}");
439 is(substr($x, 3, 1), "\x{FF}");
440 is(substr($x, 4, 1), "\x{F3}");
441
442 # And tests for already-UTF8 one
443
444 $x = "\x{101}\x{F2}\x{F3}";
445 substr($x, 0, 1) = "\x{100}";
446 is(length($x), 3);
447 is($x, "\x{100}\xF2\xF3");
448 is(substr($x, 0, 1), "\x{100}");
449 is(substr($x, 1, 1), "\x{F2}");
450 is(substr($x, 2, 1), "\x{F3}");
451
452 $x = "\x{101}\x{F2}\x{F3}";
453 substr($x, 0, 1) = "\x{100}\x{FF}";
454 is(length($x), 4);
455 is($x, "\x{100}\x{FF}\xF2\xF3");
456 is(substr($x, 0, 1), "\x{100}");
457 is(substr($x, 1, 1), "\x{FF}");
458 is(substr($x, 2, 1), "\x{F2}");
459 is(substr($x, 3, 1), "\x{F3}");
460
461 $x = "\x{101}\x{F2}\x{F3}";
462 substr($x, 0, 2) = "\x{100}\xFF";
463 is(length($x), 3);
464 is($x, "\x{100}\xFF\xF3");
465 is(substr($x, 0, 1), "\x{100}");
466 is(substr($x, 1, 1), "\x{FF}");
467 is(substr($x, 2, 1), "\x{F3}");
468
469 $x = "\x{101}\x{F2}\x{F3}";
470 substr($x, 1, 1) = "\x{100}\xFF";
471 is(length($x), 4);
472 is($x, "\x{101}\x{100}\xFF\xF3");
473 is(substr($x, 0, 1), "\x{101}");
474 is(substr($x, 1, 1), "\x{100}");
475 is(substr($x, 2, 1), "\x{FF}");
476 is(substr($x, 3, 1), "\x{F3}");
477
478 $x = "\x{101}\x{F2}\x{F3}";
479 substr($x, 2, 1) = "\x{100}\xFF";
480 is(length($x), 4);
481 is($x, "\x{101}\xF2\x{100}\xFF");
482 is(substr($x, 0, 1), "\x{101}");
483 is(substr($x, 1, 1), "\x{F2}");
484 is(substr($x, 2, 1), "\x{100}");
485 is(substr($x, 3, 1), "\x{FF}");
486
487 $x = "\x{101}\x{F2}\x{F3}";
488 substr($x, 3, 1) = "\x{100}\xFF";
489 is(length($x), 5);
490 is($x, "\x{101}\x{F2}\x{F3}\x{100}\xFF");
491 is(substr($x, 0, 1), "\x{101}");
492 is(substr($x, 1, 1), "\x{F2}");
493 is(substr($x, 2, 1), "\x{F3}");
494 is(substr($x, 3, 1), "\x{100}");
495 is(substr($x, 4, 1), "\x{FF}");
496
497 $x = "\x{101}\x{F2}\x{F3}";
498 substr($x, -1, 1) = "\x{100}\xFF";
499 is(length($x), 4);
500 is($x, "\x{101}\xF2\x{100}\xFF");
501 is(substr($x, 0, 1), "\x{101}");
502 is(substr($x, 1, 1), "\x{F2}");
503 is(substr($x, 2, 1), "\x{100}");
504 is(substr($x, 3, 1), "\x{FF}");
505
506 $x = "\x{101}\x{F2}\x{F3}";
507 substr($x, -1, 0) = "\x{100}\xFF";
508 is(length($x), 5);
509 is($x, "\x{101}\xF2\x{100}\xFF\xF3");
510 is(substr($x, 0, 1), "\x{101}");
511 is(substr($x, 1, 1), "\x{F2}");
512 is(substr($x, 2, 1), "\x{100}");
513 is(substr($x, 3, 1), "\x{FF}");
514 is(substr($x, 4, 1), "\x{F3}");
515
516 $x = "\x{101}\x{F2}\x{F3}";
517 substr($x, 0, -1) = "\x{100}\xFF";
518 is(length($x), 3);
519 is($x, "\x{100}\xFF\xF3");
520 is(substr($x, 0, 1), "\x{100}");
521 is(substr($x, 1, 1), "\x{FF}");
522 is(substr($x, 2, 1), "\x{F3}");
523
524 $x = "\x{101}\x{F2}\x{F3}";
525 substr($x, 0, -2) = "\x{100}\xFF";
526 is(length($x), 4);
527 is($x, "\x{100}\xFF\xF2\xF3");
528 is(substr($x, 0, 1), "\x{100}");
529 is(substr($x, 1, 1), "\x{FF}");
530 is(substr($x, 2, 1), "\x{F2}");
531 is(substr($x, 3, 1), "\x{F3}");
532
533 $x = "\x{101}\x{F2}\x{F3}";
534 substr($x, 0, -3) = "\x{100}\xFF";
535 is(length($x), 5);
536 is($x, "\x{100}\xFF\x{101}\x{F2}\x{F3}");
537 is(substr($x, 0, 1), "\x{100}");
538 is(substr($x, 1, 1), "\x{FF}");
539 is(substr($x, 2, 1), "\x{101}");
540 is(substr($x, 3, 1), "\x{F2}");
541 is(substr($x, 4, 1), "\x{F3}");
542
543 $x = "\x{101}\x{F2}\x{F3}";
544 substr($x, 1, -1) = "\x{100}\xFF";
545 is(length($x), 4);
546 is($x, "\x{101}\x{100}\xFF\xF3");
547 is(substr($x, 0, 1), "\x{101}");
548 is(substr($x, 1, 1), "\x{100}");
549 is(substr($x, 2, 1), "\x{FF}");
550 is(substr($x, 3, 1), "\x{F3}");
551
552 $x = "\x{101}\x{F2}\x{F3}";
553 substr($x, -1, -1) = "\x{100}\xFF";
554 is(length($x), 5);
555 is($x, "\x{101}\xF2\x{100}\xFF\xF3");
556 is(substr($x, 0, 1), "\x{101}");
557 is(substr($x, 1, 1), "\x{F2}");
558 is(substr($x, 2, 1), "\x{100}");
559 is(substr($x, 3, 1), "\x{FF}");
560 is(substr($x, 4, 1), "\x{F3}");
561
562 substr($x = "ab", 0, 0, "\x{100}\x{200}");
563 is($x, "\x{100}\x{200}ab");
564
565 substr($x = "\x{100}\x{200}", 0, 0, "ab");
566 is($x, "ab\x{100}\x{200}");
567
568 substr($x = "ab", 1, 0, "\x{100}\x{200}");
569 is($x, "a\x{100}\x{200}b");
570
571 substr($x = "\x{100}\x{200}", 1, 0, "ab");
572 is($x, "\x{100}ab\x{200}");
573
574 substr($x = "ab", 2, 0, "\x{100}\x{200}");
575 is($x, "ab\x{100}\x{200}");
576
577 substr($x = "\x{100}\x{200}", 2, 0, "ab");
578 is($x, "\x{100}\x{200}ab");
579
580 substr($x = "\xFFb", 0, 0, "\x{100}\x{200}");
581 is($x, "\x{100}\x{200}\xFFb");
582
583 substr($x = "\x{100}\x{200}", 0, 0, "\xFFb");
584 is($x, "\xFFb\x{100}\x{200}");
585
586 substr($x = "\xFFb", 1, 0, "\x{100}\x{200}");
587 is($x, "\xFF\x{100}\x{200}b");
588
589 substr($x = "\x{100}\x{200}", 1, 0, "\xFFb");
590 is($x, "\x{100}\xFFb\x{200}");
591
592 substr($x = "\xFFb", 2, 0, "\x{100}\x{200}");
593 is($x, "\xFFb\x{100}\x{200}");
594
595 substr($x = "\x{100}\x{200}", 2, 0, "\xFFb");
596 is($x, "\x{100}\x{200}\xFFb");
597
598 # [perl #20933]
599
600     my $s = "ab";
601     my @r; 
602     $r[$_] = \ substr $s, $_, 1 for (0, 1);
603     is(join("", map { $$_ } @r), "ab");
604 }
605
606 # [perl #23207]
607 {
608     sub ss {
609         substr($_[0],0,1) ^= substr($_[0],1,1) ^=
610         substr($_[0],0,1) ^= substr($_[0],1,1);
611     }
612     my $x = my $y = 'AB'; ss $x; ss $y;
613     is($x, $y);
614 }
615
616 # [perl #24605]
617 {
618     my $x = "0123456789\x{500}";
619     my $y = substr $x, 4;
620     is(substr($x, 7, 1), "7");
621 }
622
623 # multiple assignments to lvalue [perl #24346]   
624 {
625     my $x = "abcdef";
626     for (substr($x,1,3)) {
627         is($_, 'bcd');
628         $_ = 'XX';
629         is($_, 'XX');
630         is($x, 'aXXef'); 
631         $_ = "\xFF";
632         is($_, "\xFF"); 
633         is($x, "a\xFFef");
634         $_ = "\xF1\xF2\xF3\xF4\xF5\xF6";
635         is($_, "\xF1\xF2\xF3\xF4\xF5\xF6");
636         is($x, "a\xF1\xF2\xF3\xF4\xF5\xF6ef"); 
637         $_ = 'YYYY';
638         is($_, 'YYYY'); 
639         is($x, 'aYYYYef');
640     }
641 }
642
643 # [perl #24200] string corruption with lvalue sub
644
645 {
646     my $foo = "a";
647     sub bar: lvalue { substr $foo, 0 }
648     bar = "XXX";
649     is(bar, 'XXX');
650     $foo = '123456789';
651     is(bar, '123456789');
652 }
653
654 # [perl #29149]
655 {
656     my $text  = "0123456789\xED ";
657     utf8::upgrade($text);
658     my $pos = 5;
659     pos($text) = $pos;
660     my $a = substr($text, $pos, $pos);
661     is(substr($text,$pos,1), $pos);
662
663 }
664
665 # [perl #23765]
666 {
667     my $a = pack("C", 0xbf);
668     substr($a, -1) &= chr(0xfeff);
669     is($a, "\xbf");
670 }
671
672 # [perl #34976] incorrect caching of utf8 substr length
673 {
674     my  $a = "abcd\x{100}";
675     is(substr($a,1,2), 'bc');
676     is(substr($a,1,1), 'b');
677 }