#!./perl -wT
BEGIN {
chdir 't' if -d 't';
}
require './test.pl';
$x = 'foo';
$_ = "x";
s/x/\$x/;
$_ = "x";
s/x/$x/;
$_ = "x";
s/x/\$x $x/;
$b = 'cd';
($a = 'abcdef') =~ s<(b${b}e)>'\n$1';
$a = 'abacada';
$_ = 'ABACADA';
$_ = '\\' x 4;
ok( length($_) == 4 );
$snum = s/\\/\\\\/g;
ok( $_ eq '\\' x 8 && $snum == 4 );
$_ = '\/' x 4;
ok( length($_) == 8 );
$snum = s/\//\/\//g;
ok( $_ eq '\\//' x 4 && $snum == 4 );
ok( length($_) == 12 );
s/^a//;
s/a//;
s/^a/b/;
s/a/b/;
s/b$//;
s/b//;
# now for some unoptimized versions of the same.
$x ne $x || s/^a//;
$x ne $x || s/a//;
$x ne $x || s/^a/b/;
$x ne $x || s/a/b/;
$x ne $x || s/b$//;
$x ne $x || s/b//;
$_ = "aaaaa";
ok( y/a/b/ == 5 );
ok( y/a/b/ == 0 );
ok( y/b// == 5 );
ok( y/b/c/s == 5 );
ok( y/c// == 1 );
ok( y/c//d == 1 );
ok( $_ eq "" );
$_ = "Now is the %#*! time for all good men...";
ok( y/ / /s == 8 );
no utf8;
y[\301-\351][\201-\251];
} else { # Ye Olde ASCII. Or something like it.
y[\101-\132][\141-\172];
}
SKIP: {
skip("not ASCII",1) unless (ord("+") == ord(",") - 1
&& ord(",") == ord("-") - 1
&& ord("a") == ord("b") - 1
&& ord("b") == ord("c") - 1);
$_ = '+,-';
tr/+--/a-c/;
}
$_ = '+,-';
tr/+\--/a\/c/;
ok( $_ eq 'a,/' );
$_ = '+,-';
tr/-+,/ab\-/;
ok( $_ eq 'b-a' );
# test recursive substitutions
# code based on the recursive expansion of makefile variables
my %MK = (
AAAAA => '$(B)', B=>'$(C)', C => 'D', # long->short
);
sub var {
my($var,$level) = @_;
return "\$($var)" unless exists $MK{$var};
return exp_vars($MK{$var}, $level+1); # can recurse
}
sub exp_vars {
my($str,$level) = @_;
$str =~ s/\$\((\w+)\)/var($1, $level+1)/ge; # can recurse
$str;
}
$_ = "abcd";
s/(..)/$x = $1, m#.#/eg;
# Subst and lookbehind
$_="ccccc";
$snum = s/(?<!x)c/x/g;
ok( $_ eq "xxxxx" && $snum == 5 );
$_="ccccc";
$snum = s/(?<!x)(c)/x/g;
ok( $_ eq "xxxxx" && $snum == 5 );
$_="foobbarfoobbar";
ok( $_ eq "foobarfoobbar" && $snum == 1 );
$_="foobbarfoobbar";
$snum = s/(?<!ar)(foobbar)/foobar/g;
ok( $_ eq "foobarfoobbar" && $snum == 1 );
$_="foobbarfoobbar";
ok( $_ eq "foobarfoobbar" && $snum == 1 );
{bar};';
$_="baacbaa";
$snum = tr/a/b/s;
ok( $_ eq "bbcbb" && $snum == 4,
$_ = "ab";
ok( s/a/b/ == 1 );
$url = new URI::URL "http://www/"; die if $url eq "xXx";
EOL
$foo = ' $@%#lowercase $@%# lowercase UPPERCASE$@%#UPPERCASE' .
' $@%#lowercase$@%#lowercase$@%# lowercase lowercase $@%#lowercase' .
' lowercase $@%#MiXeD$@%# ';
$snum =
s{ \d+ \b [,.;]? (?{ 'digits' })
|
[a-z]+ \b [,.;]? (?{ 'lowercase' })
|
[A-Z]+ \b [,.;]? (?{ 'UPPERCASE' })
|
[A-Z] [a-z]+ \b [,.;]? (?{ 'Capitalized' })
|
|
|
\s+ (?{ ' ' })
|
}{$^R}xg;
$_ = 'a' x 6;
$_ = 'x' x 20;
$t = 'aaaaaaaaa';
$_ = $t;
pos = 6;
$_ = $t;
pos = 6;
$_ = $t;
pos = 6;
$_ = $t;
pos = 6;
s/\Ga/x/;
$_ = $t;
$_ = $t;
$_ = $t;
$_ = $t;
s/\Ga/x/;
$_ = 'aaaa';
eval q% s/a/"b"}/e %;
eval q% ($_ = "x") =~ s/(.)/"$1 "/e %;
$x = $x = 'interp';
eval q% ($_ = "x") =~ s/x(($x)*)/"$1"/e %;
$_ = "C:/";
$_ = "Charles Bronson";
$snum = s/\B\w//g;
{
use utf8;
my $s = "H\303\266he";
my $l = my $r = $s;
$l =~ s/[^\w]//g;
$r =~ s/[^\w\.]//g;
}
$pv1 =~ s/A/\x{100}/;
SKIP: {
{
# Gregor Chrupala <gregor.chrupala@star-group.net>
use utf8;
$a = 'España';
$a =~ s/ñ/ñ/;
}
{
use utf8;
$a = 'España España';
$a =~ s/ñ/ñ/;
}
{
use utf8;
$a = 'España';
$a =~ s/ñ/ñ/;
}
}
{
# SADAHIRO Tomoyuki <bqw10602@nifty.com>
$a = "\x{100}\x{101}";
$a =~ s/\x{101}/\xFF/;
$a = "\x{100}\x{101}";
$a =~ s/\x{101}/"\xFF"/e;
$a = "\x{100}\x{101}";
$a = "\x{100}\x{101}";
$a =~ s/\x{101}/"\xFF\xFF\xFF"/e;
$a = "\xFF\x{101}";
$a =~ s/\xFF/\x{100}/;
$a = "\xFF\x{101}";
$a = "\xFF";
$a =~ s/\xFF/\x{100}/;
$a = "\xFF";
}
{
my $b;
# now with utf8 pattern
}
$_ = 'aaaa';
$r = 'x';
$s = s/a(?{})/$r/g;
$_ = 'aaaa';
$s = s/a(?{})//g;
# [perl #19048] Coredump in silly replacement
{
local $^W = 0;
$_="abcdef\n";
s!.!!eg;
}
# [perl #17757] interaction between saw_ampersand and study
{
my $f = eval q{ $& };
$f = "xx";
study $f;
$f =~ s/x/y/g;
}
# [perl #20684] returned a zero count
$_ = "1111";
# [perl #20682] @- not visible in replacement
$_ = "123";
/(2)/; # seed @- with something else
s/(1)(2)(3)/$#- (@-)/;
# [perl #20682] $^N not visible in replacement
$_ = "abc";
/(a)/; s/(b)|(c)/-$^N/g;
# [perl #22351] perl bug with 'e' substitution modifier
{
}