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