-#!./perl -wT
+#!./perl -w
BEGIN {
chdir 't' if -d 't';
}
require './test.pl';
-plan( tests => 89 );
+plan( tests => 136 );
$x = 'foo';
$_ = "x";
my $l = my $r = $s;
$l =~ s/[^\w]//g;
$r =~ s/[^\w\.]//g;
- is($l, $r, "use utf8");
+ is($l, $r, "use utf8 \\w");
}
my $pv1 = my $pv2 = "Andreas J. K\303\266nig";
$pv1 =~ s/A/\x{100}/;
substr($pv2,0,1) = "\x{100}";
is($pv1, $pv2);
+
+SKIP: {
+ skip("EBCDIC", 3) if ord("A") == 193;
+
+ {
+ # Gregor Chrupala <gregor.chrupala@star-group.net>
+ use utf8;
+ $a = 'España';
+ $a =~ s/ñ/ñ/;
+ like($a, qr/ñ/, "use utf8 RHS");
+ }
+
+ {
+ use utf8;
+ $a = 'España España';
+ $a =~ s/ñ/ñ/;
+ like($a, qr/ñ/, "use utf8 LHS");
+ }
+
+ {
+ use utf8;
+ $a = 'España';
+ $a =~ s/ñ/ñ/;
+ like($a, qr/ñ/, "use utf8 LHS and RHS");
+ }
+}
+
+{
+ # SADAHIRO Tomoyuki <bqw10602@nifty.com>
+
+ $a = "\x{100}\x{101}";
+ $a =~ s/\x{101}/\xFF/;
+ like($a, qr/\xFF/);
+ is(length($a), 2, "SADAHIRO utf8 s///");
+
+ $a = "\x{100}\x{101}";
+ $a =~ s/\x{101}/"\xFF"/e;
+ like($a, qr/\xFF/);
+ is(length($a), 2);
+
+ $a = "\x{100}\x{101}";
+ $a =~ s/\x{101}/\xFF\xFF\xFF/;
+ like($a, qr/\xFF\xFF\xFF/);
+ is(length($a), 4);
+
+ $a = "\x{100}\x{101}";
+ $a =~ s/\x{101}/"\xFF\xFF\xFF"/e;
+ like($a, qr/\xFF\xFF\xFF/);
+ is(length($a), 4);
+
+ $a = "\xFF\x{101}";
+ $a =~ s/\xFF/\x{100}/;
+ like($a, qr/\x{100}/);
+ is(length($a), 2);
+
+ $a = "\xFF\x{101}";
+ $a =~ s/\xFF/"\x{100}"/e;
+ like($a, qr/\x{100}/);
+ is(length($a), 2);
+
+ $a = "\xFF";
+ $a =~ s/\xFF/\x{100}/;
+ like($a, qr/\x{100}/);
+ is(length($a), 1);
+
+ $a = "\xFF";
+ $a =~ s/\xFF/"\x{100}"/e;
+ like($a, qr/\x{100}/);
+ is(length($a), 1);
+}
+
+{
+ # subst with mixed utf8/non-utf8 type
+ my($ua, $ub, $uc, $ud) = ("\x{101}", "\x{102}", "\x{103}", "\x{104}");
+ my($na, $nb) = ("\x{ff}", "\x{fe}");
+ my $a = "$ua--$ub";
+ my $b;
+ ($b = $a) =~ s/--/$na/;
+ is($b, "$ua$na$ub", "s///: replace non-utf8 into utf8");
+ ($b = $a) =~ s/--/--$na--/;
+ is($b, "$ua--$na--$ub", "s///: replace long non-utf8 into utf8");
+ ($b = $a) =~ s/--/$uc/;
+ is($b, "$ua$uc$ub", "s///: replace utf8 into utf8");
+ ($b = $a) =~ s/--/--$uc--/;
+ is($b, "$ua--$uc--$ub", "s///: replace long utf8 into utf8");
+ $a = "$na--$nb";
+ ($b = $a) =~ s/--/$ua/;
+ is($b, "$na$ua$nb", "s///: replace utf8 into non-utf8");
+ ($b = $a) =~ s/--/--$ua--/;
+ is($b, "$na--$ua--$nb", "s///: replace long utf8 into non-utf8");
+
+ # now with utf8 pattern
+ $a = "$ua--$ub";
+ ($b = $a) =~ s/-($ud)?-/$na/;
+ is($b, "$ua$na$ub", "s///: replace non-utf8 into utf8 (utf8 pattern)");
+ ($b = $a) =~ s/-($ud)?-/--$na--/;
+ is($b, "$ua--$na--$ub", "s///: replace long non-utf8 into utf8 (utf8 pattern)");
+ ($b = $a) =~ s/-($ud)?-/$uc/;
+ is($b, "$ua$uc$ub", "s///: replace utf8 into utf8 (utf8 pattern)");
+ ($b = $a) =~ s/-($ud)?-/--$uc--/;
+ is($b, "$ua--$uc--$ub", "s///: replace long utf8 into utf8 (utf8 pattern)");
+ $a = "$na--$nb";
+ ($b = $a) =~ s/-($ud)?-/$ua/;
+ is($b, "$na$ua$nb", "s///: replace utf8 into non-utf8 (utf8 pattern)");
+ ($b = $a) =~ s/-($ud)?-/--$ua--/;
+ is($b, "$na--$ua--$nb", "s///: replace long utf8 into non-utf8 (utf8 pattern)");
+ ($b = $a) =~ s/-($ud)?-/$na/;
+ is($b, "$na$na$nb", "s///: replace non-utf8 into non-utf8 (utf8 pattern)");
+ ($b = $a) =~ s/-($ud)?-/--$na--/;
+ is($b, "$na--$na--$nb", "s///: replace long non-utf8 into non-utf8 (utf8 pattern)");
+}
+
+$_ = 'aaaa';
+$r = 'x';
+$s = s/a(?{})/$r/g;
+is("<$_> <$s>", "<xxxx> <4>", "[perl #7806]");
+
+$_ = 'aaaa';
+$s = s/a(?{})//g;
+is("<$_> <$s>", "<> <4>", "[perl #7806]");
+
+# [perl #19048] Coredump in silly replacement
+{
+ local $^W = 0;
+ $_="abcdef\n";
+ s!.!!eg;
+ is($_, "\n", "[perl #19048]");
+}
+
+# [perl #17757] interaction between saw_ampersand and study
+{
+ my $f = eval q{ $& };
+ $f = "xx";
+ study $f;
+ $f =~ s/x/y/g;
+ is($f, "yy", "[perl #17757]");
+}
+
+# [perl #20684] returned a zero count
+$_ = "1111";
+is(s/(??{1})/2/eg, 4, '#20684 s/// with (??{..}) inside');
+
+# [perl #20682] @- not visible in replacement
+$_ = "123";
+/(2)/; # seed @- with something else
+s/(1)(2)(3)/$#- (@-)/;
+is($_, "3 (0 0 1 2)", '#20682 @- not visible in replacement');
+
+# [perl #20682] $^N not visible in replacement
+$_ = "abc";
+/(a)/; s/(b)|(c)/-$^N/g;
+is($_,'a-b-c','#20682 $^N not visible in replacement');
+
+# [perl #22351] perl bug with 'e' substitution modifier
+my $name = "chris";
+{
+ no warnings 'uninitialized';
+ $name =~ s/hr//e;
+}
+is($name, "cis", q[#22351 bug with 'e' substitution modifier]);
+
+
+# [perl #34171] $1 didn't honour 'use bytes' in s//e
+{
+ my $s="\x{100}";
+ my $x;
+ {
+ use bytes;
+ $s=~ s/(..)/$x=$1/e
+ }
+ is(length($x), 2, '[perl #34171]');
+}
+
+
+{ # [perl #27940] perlbug: [\x00-\x1f] works, [\c@-\c_] does not
+ my $c;
+
+ ($c = "\x20\c@\x30\cA\x40\cZ\x50\c_\x60") =~ s/[\c@-\c_]//g;
+ is($c, "\x20\x30\x40\x50\x60", "s/[\\c\@-\\c_]//g");
+
+ ($c = "\x20\x00\x30\x01\x40\x1A\x50\x1F\x60") =~ s/[\x00-\x1f]//g;
+ is($c, "\x20\x30\x40\x50\x60", "s/[\\x00-\\x1f]//g");
+}
+{
+ $_ = "xy";
+ no warnings 'uninitialized';
+ /(((((((((x)))))))))(z)/; # clear $10
+ s/(((((((((x)))))))))(y)/${10}/;
+ is($_,"y","RT#6006: \$_ eq '$_'");
+ $_ = "xr";
+ s/(((((((((x)))))))))(r)/fooba${10}/;
+ is($_,"foobar","RT#6006: \$_ eq '$_'");
+}
+{
+ my $want=("\n" x 11).("B\n" x 11)."B";
+ $_="B";
+ our $i;
+ for $i(1..11){
+ s/^.*$/$&/gm;
+ $_="\n$_\n$&";
+ }
+ is($want,$_,"RT#17542");
+}
+