gmtime/localtime are busted around 2**48
[perl.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 require './test.pl';
26
27 plan(334);
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 my $a = 'zxcvbnm';
205 substr($a,2,0) = '';
206 is($a, 'zxcvbnm');
207 substr($a,7,0) = '';
208 is($a, 'zxcvbnm');
209 substr($a,5,0) = '';
210 is($a, 'zxcvbnm');
211 substr($a,0,2) = 'pq';
212 is($a, 'pqcvbnm');
213 substr($a,2,0) = 'r';
214 is($a, 'pqrcvbnm');
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';
222 is($a, 'fghjklsd');
223 substr($a,3,2) = '1234';
224 is($a, 'fgh1234lsd');
225
226
227 # with lexicals (and in re-entered scopes)
228 for (0,1) {
229   my $txt;
230   unless ($_) {
231     $txt = "Foo";
232     substr($txt, -1) = "X";
233     is($txt, "FoX");
234   }
235   else {
236     substr($txt, 0, 1) = "X";
237     is($txt, "X");
238   }
239 }
240
241 $w = 0 ;
242 # coercion of references
243 {
244   my $s = [];
245   substr($s, 0, 1) = 'Foo';
246   is (substr($s,0,7), "FooRRAY");
247   is ($w,2);
248   $w = 0;
249 }
250
251 # check no spurious warnings
252 is($w, 0);
253
254 # check new 4 arg replacement syntax
255 $a = "abcxyz";
256 $w = 0;
257 is(substr($a, 0, 3, ""), "abc");
258 is($a, "xyz");
259 is(substr($a, 0, 0, "abc"), "");
260 is($a, "abcxyz");
261 is(substr($a, 3, -1, ""), "xy");
262 is($a, "abcz");
263
264 is(substr($a, 3, undef, "xy"), "");
265 is($a, "abcxyz");
266 is($w, 3);
267
268 $w = 0;
269
270 is(substr($a, 3, 9999999, ""), "xyz");
271 is($a, "abc");
272 eval{substr($a, -99, 0, "") };
273 like($@, $FATAL_MSG);
274 eval{substr($a, 99, 3, "") };
275 like($@, $FATAL_MSG);
276
277 substr($a, 0, length($a), "foo");
278 is ($a, "foo");
279 is ($w, 0);
280
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/);
284 is ($a, "foo");
285
286 $a = "abcdefgh";
287 is(sub { shift }->(substr($a, 0, 4, "xxxx")), 'abcd');
288 is($a, 'xxxxefgh');
289
290 {
291     my $y = 10;
292     $y = "2" . $y;
293     is ($y, 210);
294 }
295
296 # utf8 sanity
297 {
298     my $x = substr("a\x{263a}b",0);
299     is(length($x), 3);
300     $x = substr($x,1,1);
301     is($x, "\x{263a}");
302     $x = $x x 2;
303     is(length($x), 2);
304     substr($x,0,1) = "abcd";
305     is($x, "abcd\x{263a}");
306     is(length($x), 5);
307     $x = reverse $x;
308     is(length($x), 5);
309     is($x, "\x{263a}dcba");
310
311     my $z = 10;
312     $z = "21\x{263a}" . $z;
313     is(length($z), 5);
314     is($z, "21\x{263a}10");
315 }
316
317 # replacement should work on magical values
318 require Tie::Scalar;
319 my %data;
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");
324
325 # more utf8
326
327 # The following two originally from Ignasi Roca.
328
329 $x = "\xF1\xF2\xF3";
330 substr($x, 0, 1) = "\x{100}"; # Ignasi had \x{FF}
331 is(length($x), 3);
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}");
336
337 $x = "\xF1\xF2\xF3";
338 substr($x, 0, 1) = "\x{100}\x{FF}"; # Ignasi had \x{FF}
339 is(length($x), 4);
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}");
345
346 # more utf8 lval exercise
347
348 $x = "\xF1\xF2\xF3";
349 substr($x, 0, 2) = "\x{100}\xFF";
350 is(length($x), 3);
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}");
355
356 $x = "\xF1\xF2\xF3";
357 substr($x, 1, 1) = "\x{100}\xFF";
358 is(length($x), 4);
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}");
364
365 $x = "\xF1\xF2\xF3";
366 substr($x, 2, 1) = "\x{100}\xFF";
367 is(length($x), 4);
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}");
373
374 $x = "\xF1\xF2\xF3";
375 substr($x, 3, 1) = "\x{100}\xFF";
376 is(length($x), 5);
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}");
383
384 $x = "\xF1\xF2\xF3";
385 substr($x, -1, 1) = "\x{100}\xFF";
386 is(length($x), 4);
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}");
392
393 $x = "\xF1\xF2\xF3";
394 substr($x, -1, 0) = "\x{100}\xFF";
395 is(length($x), 5);
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}");
402
403 $x = "\xF1\xF2\xF3";
404 substr($x, 0, -1) = "\x{100}\xFF";
405 is(length($x), 3);
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}");
410
411 $x = "\xF1\xF2\xF3";
412 substr($x, 0, -2) = "\x{100}\xFF";
413 is(length($x), 4);
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}");
419
420 $x = "\xF1\xF2\xF3";
421 substr($x, 0, -3) = "\x{100}\xFF";
422 is(length($x), 5);
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}");
429
430 $x = "\xF1\xF2\xF3";
431 substr($x, 1, -1) = "\x{100}\xFF";
432 is(length($x), 4);
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}");
438
439 $x = "\xF1\xF2\xF3";
440 substr($x, -1, -1) = "\x{100}\xFF";
441 is(length($x), 5);
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}");
448
449 # And tests for already-UTF8 one
450
451 $x = "\x{101}\x{F2}\x{F3}";
452 substr($x, 0, 1) = "\x{100}";
453 is(length($x), 3);
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}");
458
459 $x = "\x{101}\x{F2}\x{F3}";
460 substr($x, 0, 1) = "\x{100}\x{FF}";
461 is(length($x), 4);
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}");
467
468 $x = "\x{101}\x{F2}\x{F3}";
469 substr($x, 0, 2) = "\x{100}\xFF";
470 is(length($x), 3);
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}");
475
476 $x = "\x{101}\x{F2}\x{F3}";
477 substr($x, 1, 1) = "\x{100}\xFF";
478 is(length($x), 4);
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}");
484
485 $x = "\x{101}\x{F2}\x{F3}";
486 substr($x, 2, 1) = "\x{100}\xFF";
487 is(length($x), 4);
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}");
493
494 $x = "\x{101}\x{F2}\x{F3}";
495 substr($x, 3, 1) = "\x{100}\xFF";
496 is(length($x), 5);
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}");
503
504 $x = "\x{101}\x{F2}\x{F3}";
505 substr($x, -1, 1) = "\x{100}\xFF";
506 is(length($x), 4);
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}");
512
513 $x = "\x{101}\x{F2}\x{F3}";
514 substr($x, -1, 0) = "\x{100}\xFF";
515 is(length($x), 5);
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}");
522
523 $x = "\x{101}\x{F2}\x{F3}";
524 substr($x, 0, -1) = "\x{100}\xFF";
525 is(length($x), 3);
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}");
530
531 $x = "\x{101}\x{F2}\x{F3}";
532 substr($x, 0, -2) = "\x{100}\xFF";
533 is(length($x), 4);
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}");
539
540 $x = "\x{101}\x{F2}\x{F3}";
541 substr($x, 0, -3) = "\x{100}\xFF";
542 is(length($x), 5);
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}");
549
550 $x = "\x{101}\x{F2}\x{F3}";
551 substr($x, 1, -1) = "\x{100}\xFF";
552 is(length($x), 4);
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}");
558
559 $x = "\x{101}\x{F2}\x{F3}";
560 substr($x, -1, -1) = "\x{100}\xFF";
561 is(length($x), 5);
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}");
568
569 substr($x = "ab", 0, 0, "\x{100}\x{200}");
570 is($x, "\x{100}\x{200}ab");
571
572 substr($x = "\x{100}\x{200}", 0, 0, "ab");
573 is($x, "ab\x{100}\x{200}");
574
575 substr($x = "ab", 1, 0, "\x{100}\x{200}");
576 is($x, "a\x{100}\x{200}b");
577
578 substr($x = "\x{100}\x{200}", 1, 0, "ab");
579 is($x, "\x{100}ab\x{200}");
580
581 substr($x = "ab", 2, 0, "\x{100}\x{200}");
582 is($x, "ab\x{100}\x{200}");
583
584 substr($x = "\x{100}\x{200}", 2, 0, "ab");
585 is($x, "\x{100}\x{200}ab");
586
587 substr($x = "\xFFb", 0, 0, "\x{100}\x{200}");
588 is($x, "\x{100}\x{200}\xFFb");
589
590 substr($x = "\x{100}\x{200}", 0, 0, "\xFFb");
591 is($x, "\xFFb\x{100}\x{200}");
592
593 substr($x = "\xFFb", 1, 0, "\x{100}\x{200}");
594 is($x, "\xFF\x{100}\x{200}b");
595
596 substr($x = "\x{100}\x{200}", 1, 0, "\xFFb");
597 is($x, "\x{100}\xFFb\x{200}");
598
599 substr($x = "\xFFb", 2, 0, "\x{100}\x{200}");
600 is($x, "\xFFb\x{100}\x{200}");
601
602 substr($x = "\x{100}\x{200}", 2, 0, "\xFFb");
603 is($x, "\x{100}\x{200}\xFFb");
604
605 # [perl #20933]
606
607     my $s = "ab";
608     my @r; 
609     $r[$_] = \ substr $s, $_, 1 for (0, 1);
610     is(join("", map { $$_ } @r), "ab");
611 }
612
613 # [perl #23207]
614 {
615     sub ss {
616         substr($_[0],0,1) ^= substr($_[0],1,1) ^=
617         substr($_[0],0,1) ^= substr($_[0],1,1);
618     }
619     my $x = my $y = 'AB'; ss $x; ss $y;
620     is($x, $y);
621 }
622
623 # [perl #24605]
624 {
625     my $x = "0123456789\x{500}";
626     my $y = substr $x, 4;
627     is(substr($x, 7, 1), "7");
628 }
629
630 # multiple assignments to lvalue [perl #24346]   
631 {
632     my $x = "abcdef";
633     for (substr($x,1,3)) {
634         is($_, 'bcd');
635         $_ = 'XX';
636         is($_, 'XX');
637         is($x, 'aXXef'); 
638         $_ = "\xFF";
639         is($_, "\xFF"); 
640         is($x, "a\xFFef");
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"); 
644         $_ = 'YYYY';
645         is($_, 'YYYY'); 
646         is($x, 'aYYYYef');
647     }
648 }
649
650 # [perl #24200] string corruption with lvalue sub
651
652 {
653     sub bar: lvalue { substr $krunch, 0 }
654     bar = "XXX";
655     is(bar, 'XXX');
656     $krunch = '123456789';
657     is(bar, '123456789');
658 }
659
660 # [perl #29149]
661 {
662     my $text  = "0123456789\xED ";
663     utf8::upgrade($text);
664     my $pos = 5;
665     pos($text) = $pos;
666     my $a = substr($text, $pos, $pos);
667     is(substr($text,$pos,1), $pos);
668
669 }
670
671 # [perl #23765]
672 {
673     my $a = pack("C", 0xbf);
674     substr($a, -1) &= chr(0xfeff);
675     is($a, "\xbf");
676 }
677
678 # [perl #34976] incorrect caching of utf8 substr length
679 {
680     my  $a = "abcd\x{100}";
681     is(substr($a,1,2), 'bc');
682     is(substr($a,1,1), 'b');
683 }
684
685 }