Commit | Line | Data |
25aae3a7 |
1 | #!./perl -w |
d9d8d8de |
2 | |
a1a0e61e |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
20822f61 |
5 | @INC = '../lib'; |
a1a0e61e |
6 | require Config; import Config; |
7 | } |
344462d3 |
8 | |
e8ebd21b |
9 | require './test.pl'; |
2c296965 |
10 | plan( tests => 142 ); |
d9d8d8de |
11 | |
12 | $x = 'foo'; |
13 | $_ = "x"; |
14 | s/x/\$x/; |
e8ebd21b |
15 | ok( $_ eq '$x', ":$_: eq :\$x:" ); |
d9d8d8de |
16 | |
17 | $_ = "x"; |
18 | s/x/$x/; |
e8ebd21b |
19 | ok( $_ eq 'foo', ":$_: eq :foo:" ); |
d9d8d8de |
20 | |
21 | $_ = "x"; |
22 | s/x/\$x $x/; |
e8ebd21b |
23 | ok( $_ eq '$x foo', ":$_: eq :\$x foo:" ); |
d9d8d8de |
24 | |
25 | $b = 'cd'; |
79072805 |
26 | ($a = 'abcdef') =~ s<(b${b}e)>'\n$1'; |
e8ebd21b |
27 | ok( $1 eq 'bcde' && $a eq 'a\n$1f', ":$1: eq :bcde: ; :$a: eq :a\\n\$1f:" ); |
d9d8d8de |
28 | |
29 | $a = 'abacada'; |
e8ebd21b |
30 | ok( ($a =~ s/a/x/g) == 4 && $a eq 'xbxcxdx' ); |
d9d8d8de |
31 | |
e8ebd21b |
32 | ok( ($a =~ s/a/y/g) == 0 && $a eq 'xbxcxdx' ); |
d9d8d8de |
33 | |
e8ebd21b |
34 | ok( ($a =~ s/b/y/g) == 1 && $a eq 'xyxcxdx' ); |
d9d8d8de |
35 | |
36 | $_ = 'ABACADA'; |
e8ebd21b |
37 | ok( /a/i && s///gi && $_ eq 'BCD' ); |
d9d8d8de |
38 | |
39 | $_ = '\\' x 4; |
e8ebd21b |
40 | ok( length($_) == 4 ); |
41 | $snum = s/\\/\\\\/g; |
42 | ok( $_ eq '\\' x 8 && $snum == 4 ); |
d9d8d8de |
43 | |
44 | $_ = '\/' x 4; |
e8ebd21b |
45 | ok( length($_) == 8 ); |
46 | $snum = s/\//\/\//g; |
47 | ok( $_ eq '\\//' x 4 && $snum == 4 ); |
48 | ok( length($_) == 12 ); |
d9d8d8de |
49 | |
50 | $_ = 'aaaXXXXbbb'; |
51 | s/^a//; |
e8ebd21b |
52 | ok( $_ eq 'aaXXXXbbb' ); |
d9d8d8de |
53 | |
54 | $_ = 'aaaXXXXbbb'; |
55 | s/a//; |
e8ebd21b |
56 | ok( $_ eq 'aaXXXXbbb' ); |
d9d8d8de |
57 | |
58 | $_ = 'aaaXXXXbbb'; |
59 | s/^a/b/; |
e8ebd21b |
60 | ok( $_ eq 'baaXXXXbbb' ); |
d9d8d8de |
61 | |
62 | $_ = 'aaaXXXXbbb'; |
63 | s/a/b/; |
e8ebd21b |
64 | ok( $_ eq 'baaXXXXbbb' ); |
d9d8d8de |
65 | |
66 | $_ = 'aaaXXXXbbb'; |
67 | s/aa//; |
e8ebd21b |
68 | ok( $_ eq 'aXXXXbbb' ); |
d9d8d8de |
69 | |
70 | $_ = 'aaaXXXXbbb'; |
71 | s/aa/b/; |
e8ebd21b |
72 | ok( $_ eq 'baXXXXbbb' ); |
d9d8d8de |
73 | |
74 | $_ = 'aaaXXXXbbb'; |
75 | s/b$//; |
e8ebd21b |
76 | ok( $_ eq 'aaaXXXXbb' ); |
d9d8d8de |
77 | |
78 | $_ = 'aaaXXXXbbb'; |
79 | s/b//; |
e8ebd21b |
80 | ok( $_ eq 'aaaXXXXbb' ); |
d9d8d8de |
81 | |
82 | $_ = 'aaaXXXXbbb'; |
83 | s/bb//; |
e8ebd21b |
84 | ok( $_ eq 'aaaXXXXb' ); |
d9d8d8de |
85 | |
86 | $_ = 'aaaXXXXbbb'; |
87 | s/aX/y/; |
e8ebd21b |
88 | ok( $_ eq 'aayXXXbbb' ); |
d9d8d8de |
89 | |
90 | $_ = 'aaaXXXXbbb'; |
91 | s/Xb/z/; |
e8ebd21b |
92 | ok( $_ eq 'aaaXXXzbb' ); |
d9d8d8de |
93 | |
94 | $_ = 'aaaXXXXbbb'; |
95 | s/aaX.*Xbb//; |
e8ebd21b |
96 | ok( $_ eq 'ab' ); |
d9d8d8de |
97 | |
98 | $_ = 'aaaXXXXbbb'; |
99 | s/bb/x/; |
e8ebd21b |
100 | ok( $_ eq 'aaaXXXXxb' ); |
d9d8d8de |
101 | |
102 | # now for some unoptimized versions of the same. |
103 | |
104 | $_ = 'aaaXXXXbbb'; |
105 | $x ne $x || s/^a//; |
e8ebd21b |
106 | ok( $_ eq 'aaXXXXbbb' ); |
d9d8d8de |
107 | |
108 | $_ = 'aaaXXXXbbb'; |
109 | $x ne $x || s/a//; |
e8ebd21b |
110 | ok( $_ eq 'aaXXXXbbb' ); |
d9d8d8de |
111 | |
112 | $_ = 'aaaXXXXbbb'; |
113 | $x ne $x || s/^a/b/; |
e8ebd21b |
114 | ok( $_ eq 'baaXXXXbbb' ); |
d9d8d8de |
115 | |
116 | $_ = 'aaaXXXXbbb'; |
117 | $x ne $x || s/a/b/; |
e8ebd21b |
118 | ok( $_ eq 'baaXXXXbbb' ); |
d9d8d8de |
119 | |
120 | $_ = 'aaaXXXXbbb'; |
121 | $x ne $x || s/aa//; |
e8ebd21b |
122 | ok( $_ eq 'aXXXXbbb' ); |
d9d8d8de |
123 | |
124 | $_ = 'aaaXXXXbbb'; |
125 | $x ne $x || s/aa/b/; |
e8ebd21b |
126 | ok( $_ eq 'baXXXXbbb' ); |
d9d8d8de |
127 | |
128 | $_ = 'aaaXXXXbbb'; |
129 | $x ne $x || s/b$//; |
e8ebd21b |
130 | ok( $_ eq 'aaaXXXXbb' ); |
d9d8d8de |
131 | |
132 | $_ = 'aaaXXXXbbb'; |
133 | $x ne $x || s/b//; |
e8ebd21b |
134 | ok( $_ eq 'aaaXXXXbb' ); |
d9d8d8de |
135 | |
136 | $_ = 'aaaXXXXbbb'; |
137 | $x ne $x || s/bb//; |
e8ebd21b |
138 | ok( $_ eq 'aaaXXXXb' ); |
d9d8d8de |
139 | |
140 | $_ = 'aaaXXXXbbb'; |
141 | $x ne $x || s/aX/y/; |
e8ebd21b |
142 | ok( $_ eq 'aayXXXbbb' ); |
d9d8d8de |
143 | |
144 | $_ = 'aaaXXXXbbb'; |
145 | $x ne $x || s/Xb/z/; |
e8ebd21b |
146 | ok( $_ eq 'aaaXXXzbb' ); |
d9d8d8de |
147 | |
148 | $_ = 'aaaXXXXbbb'; |
149 | $x ne $x || s/aaX.*Xbb//; |
e8ebd21b |
150 | ok( $_ eq 'ab' ); |
d9d8d8de |
151 | |
152 | $_ = 'aaaXXXXbbb'; |
153 | $x ne $x || s/bb/x/; |
e8ebd21b |
154 | ok( $_ eq 'aaaXXXXxb' ); |
d9d8d8de |
155 | |
156 | $_ = 'abc123xyz'; |
c277df42 |
157 | s/(\d+)/$1*2/e; # yields 'abc246xyz' |
e8ebd21b |
158 | ok( $_ eq 'abc246xyz' ); |
c277df42 |
159 | s/(\d+)/sprintf("%5d",$1)/e; # yields 'abc 246xyz' |
e8ebd21b |
160 | ok( $_ eq 'abc 246xyz' ); |
c277df42 |
161 | s/(\w)/$1 x 2/eg; # yields 'aabbcc 224466xxyyzz' |
e8ebd21b |
162 | ok( $_ eq 'aabbcc 224466xxyyzz' ); |
d9d8d8de |
163 | |
164 | $_ = "aaaaa"; |
e8ebd21b |
165 | ok( y/a/b/ == 5 ); |
166 | ok( y/a/b/ == 0 ); |
167 | ok( y/b// == 5 ); |
168 | ok( y/b/c/s == 5 ); |
169 | ok( y/c// == 1 ); |
170 | ok( y/c//d == 1 ); |
171 | ok( $_ eq "" ); |
d9d8d8de |
172 | |
173 | $_ = "Now is the %#*! time for all good men..."; |
e8ebd21b |
174 | ok( ($x=(y/a-zA-Z //cd)) == 7 ); |
175 | ok( y/ / /s == 8 ); |
d9d8d8de |
176 | |
79072805 |
177 | $_ = 'abcdefghijklmnopqrstuvwxyz0123456789'; |
178 | tr/a-z/A-Z/; |
179 | |
e8ebd21b |
180 | ok( $_ eq 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789' ); |
79072805 |
181 | |
182 | # same as tr/A-Z/a-z/; |
e8ebd21b |
183 | if (defined $Config{ebcdic} && $Config{ebcdic} eq 'define') { # EBCDIC. |
6e68dac8 |
184 | no utf8; |
9d116dd7 |
185 | y[\301-\351][\201-\251]; |
186 | } else { # Ye Olde ASCII. Or something like it. |
187 | y[\101-\132][\141-\172]; |
188 | } |
79072805 |
189 | |
e8ebd21b |
190 | ok( $_ eq 'abcdefghijklmnopqrstuvwxyz0123456789' ); |
79072805 |
191 | |
e8ebd21b |
192 | SKIP: { |
193 | skip("not ASCII",1) unless (ord("+") == ord(",") - 1 |
194 | && ord(",") == ord("-") - 1 |
195 | && ord("a") == ord("b") - 1 |
196 | && ord("b") == ord("c") - 1); |
197 | $_ = '+,-'; |
198 | tr/+--/a-c/; |
199 | ok( $_ eq 'abc' ); |
9d116dd7 |
200 | } |
79072805 |
201 | |
202 | $_ = '+,-'; |
203 | tr/+\--/a\/c/; |
e8ebd21b |
204 | ok( $_ eq 'a,/' ); |
79072805 |
205 | |
206 | $_ = '+,-'; |
207 | tr/-+,/ab\-/; |
e8ebd21b |
208 | ok( $_ eq 'b-a' ); |
843b4603 |
209 | |
210 | |
211 | # test recursive substitutions |
212 | # code based on the recursive expansion of makefile variables |
213 | |
214 | my %MK = ( |
215 | AAAAA => '$(B)', B=>'$(C)', C => 'D', # long->short |
216 | E => '$(F)', F=>'p $(G) q', G => 'HHHHH', # short->long |
217 | DIR => '$(UNDEFINEDNAME)/xxx', |
218 | ); |
219 | sub var { |
220 | my($var,$level) = @_; |
221 | return "\$($var)" unless exists $MK{$var}; |
222 | return exp_vars($MK{$var}, $level+1); # can recurse |
223 | } |
224 | sub exp_vars { |
225 | my($str,$level) = @_; |
226 | $str =~ s/\$\((\w+)\)/var($1, $level+1)/ge; # can recurse |
227 | #warn "exp_vars $level = '$str'\n"; |
228 | $str; |
229 | } |
230 | |
e8ebd21b |
231 | ok( exp_vars('$(AAAAA)',0) eq 'D' ); |
232 | ok( exp_vars('$(E)',0) eq 'p HHHHH q' ); |
233 | ok( exp_vars('$(DIR)',0) eq '$(UNDEFINEDNAME)/xxx' ); |
234 | ok( exp_vars('foo $(DIR)/yyy bar',0) eq 'foo $(UNDEFINEDNAME)/xxx/yyy bar' ); |
3e3baf6d |
235 | |
236 | $_ = "abcd"; |
c277df42 |
237 | s/(..)/$x = $1, m#.#/eg; |
e8ebd21b |
238 | ok( $x eq "cd", 'a match nested in the RHS of a substitution' ); |
fb73857a |
239 | |
c277df42 |
240 | # Subst and lookbehind |
241 | |
242 | $_="ccccc"; |
e8ebd21b |
243 | $snum = s/(?<!x)c/x/g; |
244 | ok( $_ eq "xxxxx" && $snum == 5 ); |
c277df42 |
245 | |
246 | $_="ccccc"; |
e8ebd21b |
247 | $snum = s/(?<!x)(c)/x/g; |
248 | ok( $_ eq "xxxxx" && $snum == 5 ); |
c277df42 |
249 | |
250 | $_="foobbarfoobbar"; |
e8ebd21b |
251 | $snum = s/(?<!r)foobbar/foobar/g; |
252 | ok( $_ eq "foobarfoobbar" && $snum == 1 ); |
c277df42 |
253 | |
254 | $_="foobbarfoobbar"; |
e8ebd21b |
255 | $snum = s/(?<!ar)(foobbar)/foobar/g; |
256 | ok( $_ eq "foobarfoobbar" && $snum == 1 ); |
c277df42 |
257 | |
258 | $_="foobbarfoobbar"; |
e8ebd21b |
259 | $snum = s/(?<!ar)foobbar/foobar/g; |
260 | ok( $_ eq "foobarfoobbar" && $snum == 1 ); |
c277df42 |
261 | |
fb73857a |
262 | eval 's{foo} # this is a comment, not a delimiter |
263 | {bar};'; |
e8ebd21b |
264 | ok( ! @?, 'parsing of split subst with comment' ); |
f3ea7b5e |
265 | |
ed02a3bf |
266 | $snum = eval '$_="exactly"; s sxsys;m 3(yactl)3;$1'; |
267 | is( $snum, 'yactl', 'alpha delimiters are allowed' ); |
268 | |
f3ea7b5e |
269 | $_="baacbaa"; |
e8ebd21b |
270 | $snum = tr/a/b/s; |
271 | ok( $_ eq "bbcbb" && $snum == 4, |
272 | 'check if squashing works at the end of string' ); |
f3ea7b5e |
273 | |
2216f30a |
274 | $_ = "ab"; |
e8ebd21b |
275 | ok( s/a/b/ == 1 ); |
ce862d02 |
276 | |
277 | $_ = <<'EOL'; |
278 | $url = new URI::URL "http://www/"; die if $url eq "xXx"; |
279 | EOL |
280 | $^R = 'junk'; |
281 | |
282 | $foo = ' $@%#lowercase $@%# lowercase UPPERCASE$@%#UPPERCASE' . |
283 | ' $@%#lowercase$@%#lowercase$@%# lowercase lowercase $@%#lowercase' . |
284 | ' lowercase $@%#MiXeD$@%# '; |
285 | |
e8ebd21b |
286 | $snum = |
ce862d02 |
287 | s{ \d+ \b [,.;]? (?{ 'digits' }) |
288 | | |
289 | [a-z]+ \b [,.;]? (?{ 'lowercase' }) |
290 | | |
291 | [A-Z]+ \b [,.;]? (?{ 'UPPERCASE' }) |
292 | | |
293 | [A-Z] [a-z]+ \b [,.;]? (?{ 'Capitalized' }) |
294 | | |
295 | [A-Za-z]+ \b [,.;]? (?{ 'MiXeD' }) |
296 | | |
297 | [A-Za-z0-9]+ \b [,.;]? (?{ 'alphanumeric' }) |
298 | | |
299 | \s+ (?{ ' ' }) |
300 | | |
301 | [^A-Za-z0-9\s]+ (?{ '$@%#' }) |
302 | }{$^R}xg; |
e8ebd21b |
303 | ok( $_ eq $foo ); |
8e5e9ebe |
304 | ok( $snum == 31 ); |
305 | |
306 | $_ = 'a' x 6; |
307 | $snum = s/a(?{})//g; |
308 | ok( $_ eq '' && $snum == 6 ); |
ce862d02 |
309 | |
2beec16e |
310 | $_ = 'x' x 20; |
e8ebd21b |
311 | $snum = s/(\d*|x)/<$1>/g; |
2beec16e |
312 | $foo = '<>' . ('<x><>' x 20) ; |
e8ebd21b |
313 | ok( $_ eq $foo && $snum == 41 ); |
ad94a511 |
314 | |
315 | $t = 'aaaaaaaaa'; |
316 | |
317 | $_ = $t; |
318 | pos = 6; |
e8ebd21b |
319 | $snum = s/\Ga/xx/g; |
320 | ok( $_ eq 'aaaaaaxxxxxx' && $snum == 3 ); |
ad94a511 |
321 | |
322 | $_ = $t; |
323 | pos = 6; |
e8ebd21b |
324 | $snum = s/\Ga/x/g; |
325 | ok( $_ eq 'aaaaaaxxx' && $snum == 3 ); |
ad94a511 |
326 | |
327 | $_ = $t; |
328 | pos = 6; |
329 | s/\Ga/xx/; |
e8ebd21b |
330 | ok( $_ eq 'aaaaaaxxaa' ); |
ad94a511 |
331 | |
332 | $_ = $t; |
333 | pos = 6; |
334 | s/\Ga/x/; |
e8ebd21b |
335 | ok( $_ eq 'aaaaaaxaa' ); |
ad94a511 |
336 | |
337 | $_ = $t; |
e8ebd21b |
338 | $snum = s/\Ga/xx/g; |
339 | ok( $_ eq 'xxxxxxxxxxxxxxxxxx' && $snum == 9 ); |
ad94a511 |
340 | |
341 | $_ = $t; |
e8ebd21b |
342 | $snum = s/\Ga/x/g; |
343 | ok( $_ eq 'xxxxxxxxx' && $snum == 9 ); |
ad94a511 |
344 | |
345 | $_ = $t; |
346 | s/\Ga/xx/; |
e8ebd21b |
347 | ok( $_ eq 'xxaaaaaaaa' ); |
ad94a511 |
348 | |
349 | $_ = $t; |
350 | s/\Ga/x/; |
e8ebd21b |
351 | ok( $_ eq 'xaaaaaaaa' ); |
ad94a511 |
352 | |
f5c9036e |
353 | $_ = 'aaaa'; |
e8ebd21b |
354 | $snum = s/\ba/./g; |
355 | ok( $_ eq '.aaa' && $snum == 1 ); |
ad94a511 |
356 | |
e9fa98b2 |
357 | eval q% s/a/"b"}/e %; |
e8ebd21b |
358 | ok( $@ =~ /Bad evalled substitution/ ); |
e9fa98b2 |
359 | eval q% ($_ = "x") =~ s/(.)/"$1 "/e %; |
e8ebd21b |
360 | ok( $_ eq "x " and !length $@ ); |
43a16006 |
361 | $x = $x = 'interp'; |
362 | eval q% ($_ = "x") =~ s/x(($x)*)/"$1"/e %; |
e8ebd21b |
363 | ok( $_ eq '' and !length $@ ); |
e9fa98b2 |
364 | |
653099ff |
365 | $_ = "C:/"; |
e8ebd21b |
366 | ok( !s/^([a-z]:)/\u$1/ ); |
e9fa98b2 |
367 | |
12d33761 |
368 | $_ = "Charles Bronson"; |
e8ebd21b |
369 | $snum = s/\B\w//g; |
370 | ok( $_ eq "C B" && $snum == 12 ); |
5b71a6a7 |
371 | |
372 | { |
373 | use utf8; |
374 | my $s = "H\303\266he"; |
375 | my $l = my $r = $s; |
376 | $l =~ s/[^\w]//g; |
377 | $r =~ s/[^\w\.]//g; |
aefe6dfc |
378 | is($l, $r, "use utf8 \\w"); |
5b71a6a7 |
379 | } |
89afcb60 |
380 | |
381 | my $pv1 = my $pv2 = "Andreas J. K\303\266nig"; |
382 | $pv1 =~ s/A/\x{100}/; |
383 | substr($pv2,0,1) = "\x{100}"; |
384 | is($pv1, $pv2); |
aefe6dfc |
385 | |
8e9639e9 |
386 | SKIP: { |
387 | skip("EBCDIC", 3) if ord("A") == 193; |
388 | |
389 | { |
390 | # Gregor Chrupala <gregor.chrupala@star-group.net> |
391 | use utf8; |
392 | $a = 'España'; |
393 | $a =~ s/ñ/ñ/; |
394 | like($a, qr/ñ/, "use utf8 RHS"); |
395 | } |
396 | |
397 | { |
398 | use utf8; |
399 | $a = 'España España'; |
400 | $a =~ s/ñ/ñ/; |
401 | like($a, qr/ñ/, "use utf8 LHS"); |
402 | } |
403 | |
404 | { |
405 | use utf8; |
406 | $a = 'España'; |
407 | $a =~ s/ñ/ñ/; |
408 | like($a, qr/ñ/, "use utf8 LHS and RHS"); |
409 | } |
aefe6dfc |
410 | } |
411 | |
8514a05a |
412 | { |
413 | # SADAHIRO Tomoyuki <bqw10602@nifty.com> |
414 | |
415 | $a = "\x{100}\x{101}"; |
416 | $a =~ s/\x{101}/\xFF/; |
417 | like($a, qr/\xFF/); |
4a176938 |
418 | is(length($a), 2, "SADAHIRO utf8 s///"); |
8514a05a |
419 | |
420 | $a = "\x{100}\x{101}"; |
421 | $a =~ s/\x{101}/"\xFF"/e; |
422 | like($a, qr/\xFF/); |
423 | is(length($a), 2); |
424 | |
425 | $a = "\x{100}\x{101}"; |
426 | $a =~ s/\x{101}/\xFF\xFF\xFF/; |
427 | like($a, qr/\xFF\xFF\xFF/); |
428 | is(length($a), 4); |
429 | |
430 | $a = "\x{100}\x{101}"; |
431 | $a =~ s/\x{101}/"\xFF\xFF\xFF"/e; |
432 | like($a, qr/\xFF\xFF\xFF/); |
433 | is(length($a), 4); |
434 | |
435 | $a = "\xFF\x{101}"; |
436 | $a =~ s/\xFF/\x{100}/; |
437 | like($a, qr/\x{100}/); |
438 | is(length($a), 2); |
439 | |
440 | $a = "\xFF\x{101}"; |
441 | $a =~ s/\xFF/"\x{100}"/e; |
442 | like($a, qr/\x{100}/); |
443 | is(length($a), 2); |
444 | |
445 | $a = "\xFF"; |
446 | $a =~ s/\xFF/\x{100}/; |
447 | like($a, qr/\x{100}/); |
448 | is(length($a), 1); |
449 | |
450 | $a = "\xFF"; |
451 | $a =~ s/\xFF/"\x{100}"/e; |
452 | like($a, qr/\x{100}/); |
453 | is(length($a), 1); |
454 | } |
d6d0e86e |
455 | |
456 | { |
457 | # subst with mixed utf8/non-utf8 type |
458 | my($ua, $ub, $uc, $ud) = ("\x{101}", "\x{102}", "\x{103}", "\x{104}"); |
459 | my($na, $nb) = ("\x{ff}", "\x{fe}"); |
460 | my $a = "$ua--$ub"; |
461 | my $b; |
462 | ($b = $a) =~ s/--/$na/; |
463 | is($b, "$ua$na$ub", "s///: replace non-utf8 into utf8"); |
464 | ($b = $a) =~ s/--/--$na--/; |
465 | is($b, "$ua--$na--$ub", "s///: replace long non-utf8 into utf8"); |
466 | ($b = $a) =~ s/--/$uc/; |
467 | is($b, "$ua$uc$ub", "s///: replace utf8 into utf8"); |
468 | ($b = $a) =~ s/--/--$uc--/; |
469 | is($b, "$ua--$uc--$ub", "s///: replace long utf8 into utf8"); |
470 | $a = "$na--$nb"; |
471 | ($b = $a) =~ s/--/$ua/; |
472 | is($b, "$na$ua$nb", "s///: replace utf8 into non-utf8"); |
473 | ($b = $a) =~ s/--/--$ua--/; |
474 | is($b, "$na--$ua--$nb", "s///: replace long utf8 into non-utf8"); |
475 | |
476 | # now with utf8 pattern |
477 | $a = "$ua--$ub"; |
478 | ($b = $a) =~ s/-($ud)?-/$na/; |
479 | is($b, "$ua$na$ub", "s///: replace non-utf8 into utf8 (utf8 pattern)"); |
480 | ($b = $a) =~ s/-($ud)?-/--$na--/; |
481 | is($b, "$ua--$na--$ub", "s///: replace long non-utf8 into utf8 (utf8 pattern)"); |
482 | ($b = $a) =~ s/-($ud)?-/$uc/; |
483 | is($b, "$ua$uc$ub", "s///: replace utf8 into utf8 (utf8 pattern)"); |
484 | ($b = $a) =~ s/-($ud)?-/--$uc--/; |
485 | is($b, "$ua--$uc--$ub", "s///: replace long utf8 into utf8 (utf8 pattern)"); |
486 | $a = "$na--$nb"; |
487 | ($b = $a) =~ s/-($ud)?-/$ua/; |
488 | is($b, "$na$ua$nb", "s///: replace utf8 into non-utf8 (utf8 pattern)"); |
489 | ($b = $a) =~ s/-($ud)?-/--$ua--/; |
490 | is($b, "$na--$ua--$nb", "s///: replace long utf8 into non-utf8 (utf8 pattern)"); |
491 | ($b = $a) =~ s/-($ud)?-/$na/; |
492 | is($b, "$na$na$nb", "s///: replace non-utf8 into non-utf8 (utf8 pattern)"); |
493 | ($b = $a) =~ s/-($ud)?-/--$na--/; |
494 | is($b, "$na--$na--$nb", "s///: replace long non-utf8 into non-utf8 (utf8 pattern)"); |
495 | } |
496 | |
6c8d78fb |
497 | $_ = 'aaaa'; |
498 | $r = 'x'; |
499 | $s = s/a(?{})/$r/g; |
f14c76ed |
500 | is("<$_> <$s>", "<xxxx> <4>", "[perl #7806]"); |
6c8d78fb |
501 | |
502 | $_ = 'aaaa'; |
503 | $s = s/a(?{})//g; |
f14c76ed |
504 | is("<$_> <$s>", "<> <4>", "[perl #7806]"); |
6c8d78fb |
505 | |
f14c76ed |
506 | # [perl #19048] Coredump in silly replacement |
507 | { |
508 | local $^W = 0; |
509 | $_="abcdef\n"; |
510 | s!.!!eg; |
511 | is($_, "\n", "[perl #19048]"); |
512 | } |
513 | |
4addbd3b |
514 | # [perl #17757] interaction between saw_ampersand and study |
515 | { |
516 | my $f = eval q{ $& }; |
517 | $f = "xx"; |
518 | study $f; |
519 | $f =~ s/x/y/g; |
520 | is($f, "yy", "[perl #17757]"); |
521 | } |
22e13caa |
522 | |
523 | # [perl #20684] returned a zero count |
524 | $_ = "1111"; |
525 | is(s/(??{1})/2/eg, 4, '#20684 s/// with (??{..}) inside'); |
526 | |
83b43d92 |
527 | # [perl #20682] @- not visible in replacement |
528 | $_ = "123"; |
529 | /(2)/; # seed @- with something else |
530 | s/(1)(2)(3)/$#- (@-)/; |
531 | is($_, "3 (0 0 1 2)", '#20682 @- not visible in replacement'); |
532 | |
76ec6486 |
533 | # [perl #20682] $^N not visible in replacement |
534 | $_ = "abc"; |
535 | /(a)/; s/(b)|(c)/-$^N/g; |
536 | is($_,'a-b-c','#20682 $^N not visible in replacement'); |
7357df17 |
537 | |
538 | # [perl #22351] perl bug with 'e' substitution modifier |
539 | my $name = "chris"; |
540 | { |
541 | no warnings 'uninitialized'; |
542 | $name =~ s/hr//e; |
543 | } |
544 | is($name, "cis", q[#22351 bug with 'e' substitution modifier]); |
01b35787 |
545 | |
546 | |
547 | # [perl #34171] $1 didn't honour 'use bytes' in s//e |
548 | { |
549 | my $s="\x{100}"; |
550 | my $x; |
551 | { |
552 | use bytes; |
553 | $s=~ s/(..)/$x=$1/e |
554 | } |
555 | is(length($x), 2, '[perl #34171]'); |
556 | } |
557 | |
558 | |
1749ea0d |
559 | { # [perl #27940] perlbug: [\x00-\x1f] works, [\c@-\c_] does not |
560 | my $c; |
561 | |
562 | ($c = "\x20\c@\x30\cA\x40\cZ\x50\c_\x60") =~ s/[\c@-\c_]//g; |
563 | is($c, "\x20\x30\x40\x50\x60", "s/[\\c\@-\\c_]//g"); |
564 | |
565 | ($c = "\x20\x00\x30\x01\x40\x1A\x50\x1F\x60") =~ s/[\x00-\x1f]//g; |
566 | is($c, "\x20\x30\x40\x50\x60", "s/[\\x00-\\x1f]//g"); |
567 | } |
3be69782 |
568 | { |
f0852a51 |
569 | $_ = "xy"; |
570 | no warnings 'uninitialized'; |
571 | /(((((((((x)))))))))(z)/; # clear $10 |
572 | s/(((((((((x)))))))))(y)/${10}/; |
573 | is($_,"y","RT#6006: \$_ eq '$_'"); |
3be69782 |
574 | $_ = "xr"; |
575 | s/(((((((((x)))))))))(r)/fooba${10}/; |
576 | is($_,"foobar","RT#6006: \$_ eq '$_'"); |
f0852a51 |
577 | } |
336b1602 |
578 | { |
579 | my $want=("\n" x 11).("B\n" x 11)."B"; |
580 | $_="B"; |
581 | our $i; |
582 | for $i(1..11){ |
583 | s/^.*$/$&/gm; |
584 | $_="\n$_\n$&"; |
585 | } |
586 | is($want,$_,"RT#17542"); |
587 | } |
1749ea0d |
588 | |
ce474962 |
589 | { |
590 | my @tests = ('ABC', "\xA3\xA4\xA5", "\x{410}\x{411}\x{412}"); |
591 | foreach (@tests) { |
592 | my $id = ord $_; |
593 | s/./pos/ge; |
594 | is($_, "012", "RT#52104: $id"); |
595 | } |
596 | } |
831a7dd7 |
597 | |
598 | fresh_perl_is( '$_=q(foo);s/(.)\G//g;print' => 'foo', '[perl #69056] positive GPOS regex segfault' ); |
2c296965 |
599 | fresh_perl_is( '$_="abcef"; s/bc|(.)\G(.)/$1 ? "[$1-$2]" : "XX"/ge; print' => 'aXX[c-e][e-f]f', 'positive GPOS regex substitution failure' ); |
831a7dd7 |
600 | |