Commit | Line | Data |
e8ebd21b |
1 | #!./perl -wT |
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'; |
8e5e9ebe |
10 | plan( tests => 87 ); |
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 | |
f3ea7b5e |
266 | $_="baacbaa"; |
e8ebd21b |
267 | $snum = tr/a/b/s; |
268 | ok( $_ eq "bbcbb" && $snum == 4, |
269 | 'check if squashing works at the end of string' ); |
f3ea7b5e |
270 | |
2216f30a |
271 | $_ = "ab"; |
e8ebd21b |
272 | ok( s/a/b/ == 1 ); |
ce862d02 |
273 | |
274 | $_ = <<'EOL'; |
275 | $url = new URI::URL "http://www/"; die if $url eq "xXx"; |
276 | EOL |
277 | $^R = 'junk'; |
278 | |
279 | $foo = ' $@%#lowercase $@%# lowercase UPPERCASE$@%#UPPERCASE' . |
280 | ' $@%#lowercase$@%#lowercase$@%# lowercase lowercase $@%#lowercase' . |
281 | ' lowercase $@%#MiXeD$@%# '; |
282 | |
e8ebd21b |
283 | $snum = |
ce862d02 |
284 | s{ \d+ \b [,.;]? (?{ 'digits' }) |
285 | | |
286 | [a-z]+ \b [,.;]? (?{ 'lowercase' }) |
287 | | |
288 | [A-Z]+ \b [,.;]? (?{ 'UPPERCASE' }) |
289 | | |
290 | [A-Z] [a-z]+ \b [,.;]? (?{ 'Capitalized' }) |
291 | | |
292 | [A-Za-z]+ \b [,.;]? (?{ 'MiXeD' }) |
293 | | |
294 | [A-Za-z0-9]+ \b [,.;]? (?{ 'alphanumeric' }) |
295 | | |
296 | \s+ (?{ ' ' }) |
297 | | |
298 | [^A-Za-z0-9\s]+ (?{ '$@%#' }) |
299 | }{$^R}xg; |
e8ebd21b |
300 | ok( $_ eq $foo ); |
8e5e9ebe |
301 | ok( $snum == 31 ); |
302 | |
303 | $_ = 'a' x 6; |
304 | $snum = s/a(?{})//g; |
305 | ok( $_ eq '' && $snum == 6 ); |
ce862d02 |
306 | |
2beec16e |
307 | $_ = 'x' x 20; |
e8ebd21b |
308 | $snum = s/(\d*|x)/<$1>/g; |
2beec16e |
309 | $foo = '<>' . ('<x><>' x 20) ; |
e8ebd21b |
310 | ok( $_ eq $foo && $snum == 41 ); |
ad94a511 |
311 | |
312 | $t = 'aaaaaaaaa'; |
313 | |
314 | $_ = $t; |
315 | pos = 6; |
e8ebd21b |
316 | $snum = s/\Ga/xx/g; |
317 | ok( $_ eq 'aaaaaaxxxxxx' && $snum == 3 ); |
ad94a511 |
318 | |
319 | $_ = $t; |
320 | pos = 6; |
e8ebd21b |
321 | $snum = s/\Ga/x/g; |
322 | ok( $_ eq 'aaaaaaxxx' && $snum == 3 ); |
ad94a511 |
323 | |
324 | $_ = $t; |
325 | pos = 6; |
326 | s/\Ga/xx/; |
e8ebd21b |
327 | ok( $_ eq 'aaaaaaxxaa' ); |
ad94a511 |
328 | |
329 | $_ = $t; |
330 | pos = 6; |
331 | s/\Ga/x/; |
e8ebd21b |
332 | ok( $_ eq 'aaaaaaxaa' ); |
ad94a511 |
333 | |
334 | $_ = $t; |
e8ebd21b |
335 | $snum = s/\Ga/xx/g; |
336 | ok( $_ eq 'xxxxxxxxxxxxxxxxxx' && $snum == 9 ); |
ad94a511 |
337 | |
338 | $_ = $t; |
e8ebd21b |
339 | $snum = s/\Ga/x/g; |
340 | ok( $_ eq 'xxxxxxxxx' && $snum == 9 ); |
ad94a511 |
341 | |
342 | $_ = $t; |
343 | s/\Ga/xx/; |
e8ebd21b |
344 | ok( $_ eq 'xxaaaaaaaa' ); |
ad94a511 |
345 | |
346 | $_ = $t; |
347 | s/\Ga/x/; |
e8ebd21b |
348 | ok( $_ eq 'xaaaaaaaa' ); |
ad94a511 |
349 | |
f5c9036e |
350 | $_ = 'aaaa'; |
e8ebd21b |
351 | $snum = s/\ba/./g; |
352 | ok( $_ eq '.aaa' && $snum == 1 ); |
ad94a511 |
353 | |
e9fa98b2 |
354 | eval q% s/a/"b"}/e %; |
e8ebd21b |
355 | ok( $@ =~ /Bad evalled substitution/ ); |
e9fa98b2 |
356 | eval q% ($_ = "x") =~ s/(.)/"$1 "/e %; |
e8ebd21b |
357 | ok( $_ eq "x " and !length $@ ); |
43a16006 |
358 | $x = $x = 'interp'; |
359 | eval q% ($_ = "x") =~ s/x(($x)*)/"$1"/e %; |
e8ebd21b |
360 | ok( $_ eq '' and !length $@ ); |
e9fa98b2 |
361 | |
653099ff |
362 | $_ = "C:/"; |
e8ebd21b |
363 | ok( !s/^([a-z]:)/\u$1/ ); |
e9fa98b2 |
364 | |
12d33761 |
365 | $_ = "Charles Bronson"; |
e8ebd21b |
366 | $snum = s/\B\w//g; |
367 | ok( $_ eq "C B" && $snum == 12 ); |