Commit | Line | Data |
---|---|---|
e198f039 | 1 | #!./perl -w |
84902520 TB |
2 | |
3 | #P = start of string Q = start of substr R = end of substr S = end of string | |
a687059c | 4 | |
e476b1b5 | 5 | BEGIN { |
3aa33fe5 | 6 | chdir 't' if -d 't'; |
20822f61 | 7 | @INC = '../lib'; |
e476b1b5 GS |
8 | } |
9 | use warnings ; | |
84902520 | 10 | |
e476b1b5 | 11 | $a = 'abcdefxyz'; |
84902520 TB |
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; | |
5d82c453 GA |
17 | } elsif ($_[0] =~ /^Use of uninitialized value/) { |
18 | $w += 3; | |
84902520 | 19 | } else { |
5d82c453 | 20 | warn $_[0]; |
84902520 TB |
21 | } |
22 | }; | |
a687059c | 23 | |
e198f039 NC |
24 | require './test.pl'; |
25 | ||
26 | plan(334); | |
e476b1b5 | 27 | |
e198f039 | 28 | $FATAL_MSG = qr/^substr outside of string/; |
84902520 | 29 | |
e198f039 NC |
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 | |
e476b1b5 | 33 | $b = substr($a,999,999) ; # warn # P R Q S |
e198f039 | 34 | is ($w--, 1); |
e476b1b5 | 35 | eval{substr($a,999,999) = "" ; };# P R Q S |
e198f039 NC |
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 | |
a687059c LW |
39 | |
40 | $[ = 1; | |
41 | ||
e198f039 NC |
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 | |
e476b1b5 | 45 | $b = substr($a,999,999) ; # warn # P R Q S |
e198f039 | 46 | is($w--, 1); |
e476b1b5 | 47 | eval{substr($a,999,999) = "" ; } ; # P R Q S |
e198f039 NC |
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 | |
a687059c LW |
51 | |
52 | $[ = 0; | |
53 | ||
54 | substr($a,3,3) = 'XYZ'; | |
e198f039 | 55 | is($a, 'abcXYZxyz' ); |
a687059c | 56 | substr($a,0,2) = ''; |
e198f039 | 57 | is($a, 'cXYZxyz' ); |
a687059c | 58 | substr($a,0,0) = 'ab'; |
e198f039 | 59 | is($a, 'abcXYZxyz' ); |
a687059c | 60 | substr($a,0,0) = '12345678'; |
e198f039 | 61 | is($a, '12345678abcXYZxyz' ); |
a687059c | 62 | substr($a,-3,3) = 'def'; |
e198f039 | 63 | is($a, '12345678abcXYZdef'); |
a687059c | 64 | substr($a,-3,3) = '<'; |
e198f039 | 65 | is($a, '12345678abcXYZ<' ); |
a687059c | 66 | substr($a,-1,1) = '12345678'; |
e198f039 | 67 | is($a, '12345678abcXYZ12345678' ); |
a687059c | 68 | |
d9d8d8de LW |
69 | $a = 'abcdefxyz'; |
70 | ||
e198f039 NC |
71 | is(substr($a,6), 'xyz' ); # P Q R=S |
72 | is(substr($a,-3), 'xyz' ); # P Q R=S | |
e476b1b5 | 73 | $b = substr($a,999,999) ; # warning # P R=S Q |
e198f039 | 74 | is($w--, 1); |
e476b1b5 | 75 | eval{substr($a,999,999) = "" ; } ; # P R=S Q |
e198f039 NC |
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 | |
84902520 TB |
81 | |
82 | $a = '54321'; | |
83 | ||
e476b1b5 | 84 | $b = substr($a,-7, 1) ; # warn # Q R P S |
e198f039 | 85 | is($w--, 1); |
e476b1b5 | 86 | eval{substr($a,-7, 1) = "" ; }; # Q R P S |
e198f039 | 87 | like($@, $FATAL_MSG); |
e476b1b5 | 88 | $b = substr($a,-7,-6) ; # warn # Q R P S |
e198f039 | 89 | is($w--, 1); |
e476b1b5 | 90 | eval{substr($a,-7,-6) = "" ; }; # Q R P S |
e198f039 NC |
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 | |
e476b1b5 | 102 | $b = substr($a, 7,-7) ; # warn # R P S Q |
e198f039 | 103 | is($w--, 1); |
e476b1b5 | 104 | eval{substr($a, 7,-7) = "" ; }; # R P S Q |
e198f039 | 105 | like($@, $FATAL_MSG); |
e476b1b5 | 106 | $b = substr($a, 7,-5) ; # warn # P=R S Q |
e198f039 | 107 | is($w--, 1); |
e476b1b5 | 108 | eval{substr($a, 7,-5) = "" ; }; # P=R S Q |
e198f039 | 109 | like($@, $FATAL_MSG); |
e476b1b5 | 110 | $b = substr($a, 7,-3) ; # warn # P Q S Q |
e198f039 | 111 | is($w--, 1); |
e476b1b5 | 112 | eval{substr($a, 7,-3) = "" ; }; # P Q S Q |
e198f039 | 113 | like($@, $FATAL_MSG); |
e476b1b5 | 114 | $b = substr($a, 7, 0) ; # warn # P S Q=R |
e198f039 | 115 | is($w--, 1); |
e476b1b5 | 116 | eval{substr($a, 7, 0) = "" ; }; # P S Q=R |
e198f039 NC |
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 | |
84902520 TB |
145 | |
146 | $a = ''; | |
147 | ||
e198f039 NC |
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 | |
e476b1b5 GS |
154 | |
155 | ||
e198f039 | 156 | is(substr($a,0,-1), ''); # R P=Q=S |
e476b1b5 | 157 | $b = substr($a,-2, 0) ; # warn # Q=R P=S |
e198f039 | 158 | is($w--, 1); |
e476b1b5 | 159 | eval{substr($a,-2, 0) = "" ; }; # Q=R P=S |
e198f039 | 160 | like($@, $FATAL_MSG); |
84902520 | 161 | |
e476b1b5 | 162 | $b = substr($a,-2, 1) ; # warn # Q R P=S |
e198f039 | 163 | is($w--, 1); |
e476b1b5 | 164 | eval{substr($a,-2, 1) = "" ; }; # Q R P=S |
e198f039 | 165 | like($@, $FATAL_MSG); |
84902520 | 166 | |
e476b1b5 | 167 | $b = substr($a,-2,-1) ; # warn # Q R P=S |
e198f039 | 168 | is($w--, 1); |
e476b1b5 | 169 | eval{substr($a,-2,-1) = "" ; }; # Q R P=S |
e198f039 | 170 | like($@, $FATAL_MSG); |
84902520 | 171 | |
e476b1b5 | 172 | $b = substr($a,-2,-2) ; # warn # Q=R P=S |
e198f039 | 173 | is($w--, 1); |
e476b1b5 | 174 | eval{substr($a,-2,-2) = "" ; }; # Q=R P=S |
e198f039 | 175 | like($@, $FATAL_MSG); |
e476b1b5 GS |
176 | |
177 | $b = substr($a, 1,-2) ; # warn # R P=S Q | |
e198f039 | 178 | is($w--, 1); |
e476b1b5 | 179 | eval{substr($a, 1,-2) = "" ; }; # R P=S Q |
e198f039 | 180 | like($@, $FATAL_MSG); |
e476b1b5 GS |
181 | |
182 | $b = substr($a, 1, 1) ; # warn # P=S Q R | |
e198f039 | 183 | is($w--, 1); |
e476b1b5 | 184 | eval{substr($a, 1, 1) = "" ; }; # P=S Q R |
e198f039 | 185 | like($@, $FATAL_MSG); |
e476b1b5 GS |
186 | |
187 | $b = substr($a, 1, 0) ;# warn # P=S Q=R | |
e198f039 | 188 | is($w--, 1); |
e476b1b5 | 189 | eval{substr($a, 1, 0) = "" ; }; # P=S Q=R |
e198f039 | 190 | like($@, $FATAL_MSG); |
e476b1b5 GS |
191 | |
192 | $b = substr($a,1) ; # warning # P=R=S Q | |
e198f039 | 193 | is($w--, 1); |
e476b1b5 | 194 | eval{substr($a,1) = "" ; }; # P=R=S Q |
e198f039 | 195 | like($@, $FATAL_MSG); |
84902520 TB |
196 | |
197 | my $a = 'zxcvbnm'; | |
198 | substr($a,2,0) = ''; | |
e198f039 | 199 | is($a, 'zxcvbnm'); |
84902520 | 200 | substr($a,7,0) = ''; |
e198f039 | 201 | is($a, 'zxcvbnm'); |
84902520 | 202 | substr($a,5,0) = ''; |
e198f039 | 203 | is($a, 'zxcvbnm'); |
84902520 | 204 | substr($a,0,2) = 'pq'; |
e198f039 | 205 | is($a, 'pqcvbnm'); |
84902520 | 206 | substr($a,2,0) = 'r'; |
e198f039 | 207 | is($a, 'pqrcvbnm'); |
84902520 | 208 | substr($a,8,0) = 'asd'; |
e198f039 | 209 | is($a, 'pqrcvbnmasd'); |
84902520 | 210 | substr($a,0,2) = 'iop'; |
e198f039 | 211 | is($a, 'ioprcvbnmasd'); |
84902520 | 212 | substr($a,0,5) = 'fgh'; |
e198f039 | 213 | is($a, 'fghvbnmasd'); |
84902520 | 214 | substr($a,3,5) = 'jkl'; |
e198f039 | 215 | is($a, 'fghjklsd'); |
84902520 | 216 | substr($a,3,2) = '1234'; |
e198f039 | 217 | is($a, 'fgh1234lsd'); |
84902520 | 218 | |
08cb0b0d | 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"; | |
e198f039 | 226 | is($txt, "FoX"); |
08cb0b0d | 227 | } |
228 | else { | |
229 | substr($txt, 0, 1) = "X"; | |
e198f039 | 230 | is($txt, "X"); |
08cb0b0d | 231 | } |
232 | } | |
233 | ||
e476b1b5 | 234 | $w = 0 ; |
84902520 | 235 | # coercion of references |
08cb0b0d | 236 | { |
237 | my $s = []; | |
238 | substr($s, 0, 1) = 'Foo'; | |
e198f039 NC |
239 | is (substr($s,0,7), "FooRRAY"); |
240 | is ($w,2); | |
241 | $w = 0; | |
08cb0b0d | 242 | } |
84902520 TB |
243 | |
244 | # check no spurious warnings | |
e198f039 | 245 | is($w, 0); |
7b8d334a | 246 | |
5d82c453 | 247 | # check new 4 arg replacement syntax |
7b8d334a | 248 | $a = "abcxyz"; |
5d82c453 | 249 | $w = 0; |
e198f039 NC |
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"); | |
e476b1b5 | 256 | |
e198f039 NC |
257 | is(substr($a, 3, undef, "xy"), ""); |
258 | is($a, "abcxyz"); | |
259 | is($w, 3); | |
e476b1b5 | 260 | |
5d82c453 GA |
261 | $w = 0; |
262 | ||
e198f039 NC |
263 | is(substr($a, 3, 9999999, ""), "xyz"); |
264 | is($a, "abc"); | |
e476b1b5 | 265 | eval{substr($a, -99, 0, "") }; |
e198f039 | 266 | like($@, $FATAL_MSG); |
e476b1b5 | 267 | eval{substr($a, 99, 3, "") }; |
e198f039 | 268 | like($@, $FATAL_MSG); |
5d82c453 GA |
269 | |
270 | substr($a, 0, length($a), "foo"); | |
e198f039 NC |
271 | is ($a, "foo"); |
272 | is ($w, 0); | |
5d82c453 GA |
273 | |
274 | # using 4 arg substr as lvalue is a compile time error | |
275 | eval 'substr($a,0,0,"") = "abc"'; | |
e198f039 NC |
276 | like ($@, qr/Can't modify substr/); |
277 | is ($a, "foo"); | |
c8faf1c5 GS |
278 | |
279 | $a = "abcdefgh"; | |
e198f039 NC |
280 | is(sub { shift }->(substr($a, 0, 4, "xxxx")), 'abcd'); |
281 | is($a, 'xxxxefgh'); | |
7f66633b | 282 | |
e84ff256 GS |
283 | { |
284 | my $y = 10; | |
285 | $y = "2" . $y; | |
e198f039 | 286 | is ($y, 210); |
e84ff256 GS |
287 | } |
288 | ||
7f66633b GS |
289 | # utf8 sanity |
290 | { | |
291 | my $x = substr("a\x{263a}b",0); | |
e198f039 | 292 | is(length($x), 3); |
7f66633b | 293 | $x = substr($x,1,1); |
e198f039 | 294 | is($x, "\x{263a}"); |
dfcb284a | 295 | $x = $x x 2; |
e198f039 | 296 | is(length($x), 2); |
7f66633b | 297 | substr($x,0,1) = "abcd"; |
e198f039 NC |
298 | is($x, "abcd\x{263a}"); |
299 | is(length($x), 5); | |
e84ff256 | 300 | $x = reverse $x; |
e198f039 NC |
301 | is(length($x), 5); |
302 | is($x, "\x{263a}dcba"); | |
e84ff256 GS |
303 | |
304 | my $z = 10; | |
305 | $z = "21\x{263a}" . $z; | |
e198f039 NC |
306 | is(length($z), 5); |
307 | is($z, "21\x{263a}10"); | |
7f66633b | 308 | } |
35fba0d9 RG |
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"; | |
e198f039 NC |
315 | is(substr($data{'a'}, 0, 5, ""), "first"); |
316 | is($data{'a'}, "last"); | |
075a4a2b JH |
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} | |
e198f039 NC |
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}"); | |
075a4a2b JH |
329 | |
330 | $x = "\xF1\xF2\xF3"; | |
331 | substr($x, 0, 1) = "\x{100}\x{FF}"; # Ignasi had \x{FF} | |
e198f039 NC |
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}"); | |
075a4a2b JH |
338 | |
339 | # more utf8 lval exercise | |
340 | ||
341 | $x = "\xF1\xF2\xF3"; | |
342 | substr($x, 0, 2) = "\x{100}\xFF"; | |
e198f039 NC |
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}"); | |
075a4a2b JH |
348 | |
349 | $x = "\xF1\xF2\xF3"; | |
350 | substr($x, 1, 1) = "\x{100}\xFF"; | |
e198f039 NC |
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}"); | |
075a4a2b JH |
357 | |
358 | $x = "\xF1\xF2\xF3"; | |
359 | substr($x, 2, 1) = "\x{100}\xFF"; | |
e198f039 NC |
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}"); | |
075a4a2b JH |
366 | |
367 | $x = "\xF1\xF2\xF3"; | |
368 | substr($x, 3, 1) = "\x{100}\xFF"; | |
e198f039 NC |
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}"); | |
075a4a2b JH |
376 | |
377 | $x = "\xF1\xF2\xF3"; | |
378 | substr($x, -1, 1) = "\x{100}\xFF"; | |
e198f039 NC |
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}"); | |
075a4a2b JH |
385 | |
386 | $x = "\xF1\xF2\xF3"; | |
387 | substr($x, -1, 0) = "\x{100}\xFF"; | |
e198f039 NC |
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}"); | |
075a4a2b JH |
395 | |
396 | $x = "\xF1\xF2\xF3"; | |
397 | substr($x, 0, -1) = "\x{100}\xFF"; | |
e198f039 NC |
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}"); | |
075a4a2b JH |
403 | |
404 | $x = "\xF1\xF2\xF3"; | |
405 | substr($x, 0, -2) = "\x{100}\xFF"; | |
e198f039 NC |
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}"); | |
075a4a2b JH |
412 | |
413 | $x = "\xF1\xF2\xF3"; | |
414 | substr($x, 0, -3) = "\x{100}\xFF"; | |
e198f039 NC |
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}"); | |
075a4a2b JH |
422 | |
423 | $x = "\xF1\xF2\xF3"; | |
424 | substr($x, 1, -1) = "\x{100}\xFF"; | |
e198f039 NC |
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}"); | |
075a4a2b JH |
431 | |
432 | $x = "\xF1\xF2\xF3"; | |
433 | substr($x, -1, -1) = "\x{100}\xFF"; | |
e198f039 NC |
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}"); | |
075a4a2b | 441 | |
9aa983d2 JH |
442 | # And tests for already-UTF8 one |
443 | ||
444 | $x = "\x{101}\x{F2}\x{F3}"; | |
445 | substr($x, 0, 1) = "\x{100}"; | |
e198f039 NC |
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}"); | |
9aa983d2 JH |
451 | |
452 | $x = "\x{101}\x{F2}\x{F3}"; | |
453 | substr($x, 0, 1) = "\x{100}\x{FF}"; | |
e198f039 NC |
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}"); | |
9aa983d2 JH |
460 | |
461 | $x = "\x{101}\x{F2}\x{F3}"; | |
462 | substr($x, 0, 2) = "\x{100}\xFF"; | |
e198f039 NC |
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}"); | |
9aa983d2 JH |
468 | |
469 | $x = "\x{101}\x{F2}\x{F3}"; | |
470 | substr($x, 1, 1) = "\x{100}\xFF"; | |
e198f039 NC |
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}"); | |
9aa983d2 JH |
477 | |
478 | $x = "\x{101}\x{F2}\x{F3}"; | |
479 | substr($x, 2, 1) = "\x{100}\xFF"; | |
e198f039 NC |
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}"); | |
9aa983d2 JH |
486 | |
487 | $x = "\x{101}\x{F2}\x{F3}"; | |
488 | substr($x, 3, 1) = "\x{100}\xFF"; | |
e198f039 NC |
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}"); | |
9aa983d2 JH |
496 | |
497 | $x = "\x{101}\x{F2}\x{F3}"; | |
498 | substr($x, -1, 1) = "\x{100}\xFF"; | |
e198f039 NC |
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}"); | |
9aa983d2 JH |
505 | |
506 | $x = "\x{101}\x{F2}\x{F3}"; | |
507 | substr($x, -1, 0) = "\x{100}\xFF"; | |
e198f039 NC |
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}"); | |
9aa983d2 JH |
515 | |
516 | $x = "\x{101}\x{F2}\x{F3}"; | |
517 | substr($x, 0, -1) = "\x{100}\xFF"; | |
e198f039 NC |
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}"); | |
9aa983d2 JH |
523 | |
524 | $x = "\x{101}\x{F2}\x{F3}"; | |
525 | substr($x, 0, -2) = "\x{100}\xFF"; | |
e198f039 NC |
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}"); | |
9aa983d2 JH |
532 | |
533 | $x = "\x{101}\x{F2}\x{F3}"; | |
534 | substr($x, 0, -3) = "\x{100}\xFF"; | |
e198f039 NC |
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}"); | |
9aa983d2 JH |
542 | |
543 | $x = "\x{101}\x{F2}\x{F3}"; | |
544 | substr($x, 1, -1) = "\x{100}\xFF"; | |
e198f039 NC |
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}"); | |
9aa983d2 JH |
551 | |
552 | $x = "\x{101}\x{F2}\x{F3}"; | |
553 | substr($x, -1, -1) = "\x{100}\xFF"; | |
e198f039 NC |
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}"); | |
f7928d6c JH |
561 | |
562 | substr($x = "ab", 0, 0, "\x{100}\x{200}"); | |
e198f039 | 563 | is($x, "\x{100}\x{200}ab"); |
f7928d6c JH |
564 | |
565 | substr($x = "\x{100}\x{200}", 0, 0, "ab"); | |
e198f039 | 566 | is($x, "ab\x{100}\x{200}"); |
f7928d6c JH |
567 | |
568 | substr($x = "ab", 1, 0, "\x{100}\x{200}"); | |
e198f039 | 569 | is($x, "a\x{100}\x{200}b"); |
f7928d6c JH |
570 | |
571 | substr($x = "\x{100}\x{200}", 1, 0, "ab"); | |
e198f039 | 572 | is($x, "\x{100}ab\x{200}"); |
f7928d6c JH |
573 | |
574 | substr($x = "ab", 2, 0, "\x{100}\x{200}"); | |
e198f039 | 575 | is($x, "ab\x{100}\x{200}"); |
f7928d6c JH |
576 | |
577 | substr($x = "\x{100}\x{200}", 2, 0, "ab"); | |
e198f039 | 578 | is($x, "\x{100}\x{200}ab"); |
f7928d6c | 579 | |
9402d6ed | 580 | substr($x = "\xFFb", 0, 0, "\x{100}\x{200}"); |
e198f039 | 581 | is($x, "\x{100}\x{200}\xFFb"); |
9402d6ed JH |
582 | |
583 | substr($x = "\x{100}\x{200}", 0, 0, "\xFFb"); | |
e198f039 | 584 | is($x, "\xFFb\x{100}\x{200}"); |
9402d6ed JH |
585 | |
586 | substr($x = "\xFFb", 1, 0, "\x{100}\x{200}"); | |
e198f039 | 587 | is($x, "\xFF\x{100}\x{200}b"); |
9402d6ed JH |
588 | |
589 | substr($x = "\x{100}\x{200}", 1, 0, "\xFFb"); | |
e198f039 | 590 | is($x, "\x{100}\xFFb\x{200}"); |
9402d6ed JH |
591 | |
592 | substr($x = "\xFFb", 2, 0, "\x{100}\x{200}"); | |
e198f039 | 593 | is($x, "\xFFb\x{100}\x{200}"); |
9402d6ed JH |
594 | |
595 | substr($x = "\x{100}\x{200}", 2, 0, "\xFFb"); | |
e198f039 | 596 | is($x, "\x{100}\x{200}\xFFb"); |
9402d6ed | 597 | |
24aef97f HS |
598 | # [perl #20933] |
599 | { | |
600 | my $s = "ab"; | |
601 | my @r; | |
602 | $r[$_] = \ substr $s, $_, 1 for (0, 1); | |
e198f039 | 603 | is(join("", map { $$_ } @r), "ab"); |
24aef97f | 604 | } |
6214ab63 AE |
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; | |
e198f039 | 613 | is($x, $y); |
6214ab63 | 614 | } |
8f78557a AE |
615 | |
616 | # [perl #24605] | |
617 | { | |
618 | my $x = "0123456789\x{500}"; | |
619 | my $y = substr $x, 4; | |
e198f039 | 620 | is(substr($x, 7, 1), "7"); |
8f78557a | 621 | } |
c2552146 DM |
622 | |
623 | # multiple assignments to lvalue [perl #24346] | |
624 | { | |
625 | my $x = "abcdef"; | |
626 | for (substr($x,1,3)) { | |
e198f039 | 627 | is($_, 'bcd'); |
c2552146 | 628 | $_ = 'XX'; |
e198f039 NC |
629 | is($_, 'XX'); |
630 | is($x, 'aXXef'); | |
c2552146 | 631 | $_ = "\xFF"; |
e198f039 NC |
632 | is($_, "\xFF"); |
633 | is($x, "a\xFFef"); | |
c2552146 | 634 | $_ = "\xF1\xF2\xF3\xF4\xF5\xF6"; |
e198f039 NC |
635 | is($_, "\xF1\xF2\xF3\xF4\xF5\xF6"); |
636 | is($x, "a\xF1\xF2\xF3\xF4\xF5\xF6ef"); | |
c2552146 | 637 | $_ = 'YYYY'; |
e198f039 NC |
638 | is($_, 'YYYY'); |
639 | is($x, 'aYYYYef'); | |
c2552146 DM |
640 | } |
641 | } | |
781e7547 DM |
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"; | |
e198f039 | 649 | is(bar, 'XXX'); |
781e7547 | 650 | $foo = '123456789'; |
e198f039 | 651 | is(bar, '123456789'); |
781e7547 | 652 | } |
a67d7df9 TS |
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); | |
e198f039 | 661 | is(substr($text,$pos,1), $pos); |
a67d7df9 TS |
662 | |
663 | } | |
080534f4 RGS |
664 | |
665 | # [perl #23765] | |
666 | { | |
667 | my $a = pack("C", 0xbf); | |
668 | substr($a, -1) &= chr(0xfeff); | |
e198f039 | 669 | is($a, "\xbf"); |
080534f4 | 670 | } |
ec062429 DM |
671 | |
672 | # [perl #34976] incorrect caching of utf8 substr length | |
673 | { | |
674 | my $a = "abcd\x{100}"; | |
e198f039 NC |
675 | is(substr($a,1,2), 'bc'); |
676 | is(substr($a,1,1), 'b'); | |
ec062429 | 677 | } |