BEGIN {
chdir 't' if -d 't';
- @INC = ('../lib','.');
- require './test.pl';
+ require './test.pl'; require './charset_tools.pl';
+ set_up_inc('../lib');
}
-plan tests => 525; # Update this when adding/deleting tests.
+plan tests => 527; # Update this when adding/deleting tests.
run_tests() unless caller;
ok 'goodfood' =~ $a, "Reblessed qr // matches";
is($a, '(?^:foo)', "Reblessed qr // stringifies");
my $x = "\x{3fe}";
- my $z = my $y = "\317\276"; # Byte representation of $x
+ my $z = my $y = byte_utf8a_to_utf8n("\317\276"); # Byte representation
+ # of $x
$a = qr /$x/;
ok $x =~ $a, "UTF-8 interpolation in qr //";
ok "a$a" =~ $x, "Stringified qr // preserves UTF-8";
is("@ctl_n", "1 2 undef", 'Bug 56194');
is("@plus", "1 2 undef", 'Bug 56194');
is($str,
- "\$1 = undef, \$2 = undef, \$3 = undef, \$4 = undef, \$5 = undef, \$^R = undef",
- 'Bug 56194');
+ "\$1 = undef, \$2 = undef, \$3 = undef, \$4 = undef, \$5 = undef, \$^R = 3",
+ 'Bug 56194 ($^R tweaked by 121070)');
+ }
+ {
+ undef $^R;
+ "abcd"=~/(?<Char>.)(?&Char)(?{ 42 })/;
+ is("$^R", 42, 'Bug 121070 - use of (?&Char) should not clobber $^R');
+ "abcd"=~/(?<Char>.)(?&Char)(?{ 42 })(?{ 43 })/;
+ is("$^R", 43, 'related to 121070 - use of (?&Char) should not clobber $^R');
}
}
}
# and make sure things are freed at the right time
-
- SKIP: {
- if ($Config{mad}) {
- skip "MAD doesn't free eval CVs", 3;
- }
-
+ {
+ sub Foo99::DESTROY { $Foo99::d++ }
+ $Foo99::d = 0;
+ my $r1;
{
- sub Foo99::DESTROY { $Foo99::d++ }
- $Foo99::d = 0;
- my $r1;
- {
- my $x = bless [1], 'Foo99';
- $r1 = eval 'qr/(??{$x->[0]})/';
- }
- my $r2 = eval 'qr/a$r1/';
- my $x = 2;
- ok(eval '"a1" =~ qr/^$r2$/', "match while in scope");
- # make sure PL_reg_curpm isn't holding on to anything
- "a" =~ /a(?{1})/;
- is($Foo99::d, 0, "before scope exit");
+ my $x = bless [1], 'Foo99';
+ $r1 = eval 'qr/(??{$x->[0]})/';
}
- ::is($Foo99::d, 1, "after scope exit");
+ my $r2 = eval 'qr/a$r1/';
+ my $x = 2;
+ ok(eval '"a1" =~ qr/^$r2$/', "match while in scope");
+ # make sure PL_reg_curpm isn't holding on to anything
+ "a" =~ /a(?{1})/;
+ is($Foo99::d, 0, "before scope exit");
}
+ ::is($Foo99::d, 1, "after scope exit");
# forward declared subs should Do The Right Thing with any anon CVs
# within them (i.e. pad_fixup_inner_anons() should work)
# does all the right escapes
{
- my $enc = eval 'use Encode; find_encoding("ascii")';
+ my $enc;
+ $enc = eval 'use Encode; find_encoding("ascii")' unless $::IS_EBCDIC;
my $x = 0;
my $y = 'bad';
my $s = shift;
$s =~ s{(.)}{
my $c = ord($1);
- ($c< 32 || $c > 127) ? sprintf("<0x%x>", $c) : $1;
+ (utf8::native_to_unicode($c)< 32
+ || utf8::native_to_unicode($c) > 127)
+ ? sprintf("<0x%x>", $c) : $1;
}ge;
$s;
}
ok($ss =~ /^$cc/, fmt("plain $u->[2]", $ss, $cc));
no strict;
- my $chr41 = "\x41";
- $ss = "$u->[0]\t${q}$chr41${b}x42$s";
$nine = $nine = "bad";
+ $ss = "$u->[0]\t${q}\x41${b}x42$s" if $::IS_ASCII;
+ $ss = "$u->[0]\t${q}\xC1${b}xC2$s" if $::IS_EBCDIC;
for my $use_qr ('', 'qr') {
$c = qq[(??{my \$z='{';]
- . qq[$use_qr"$b${b}t$b$q$b${b}x41$b$b$b${b}x42"]
+ . (($::IS_ASCII)
+ ? qq[$use_qr"$b${b}t$b$q$b${b}x41$b$b$b${b}x42"]
+ : qq[$use_qr"$b${b}t$b$q$b${b}xC1$b$b$b${b}xC2"])
. qq[. \$nine})];
# (??{ qr/str/ }) goes through one less interpolation
# stage than (??{ qq/str/ })
ok($ss =~ /^$cc/, fmt("code $u->[2]", $ss, $cc));
}
+ SKIP:
{
+ skip("Encode not working on EBCDIC", 1) unless defined $enc;
# Poor man's "use encoding 'ascii'".
# This causes a different code path in S_const_str()
# to be used
+ no warnings 'deprecated';
local ${^ENCODING} = $enc;
+ use warnings 'deprecated';
use re 'eval';
ok($ss =~ /^$cc/, fmt("encode $u->[2]", $ss, $cc));
}
}
my $code1u = "(??{qw(\x{100})})";
- eval {/^$code1u$/}; norun("reparse embeded unicode norun");
+ eval {/^$code1u$/}; norun("reparse embedded unicode norun");
{
use re 'eval';
- ok("\x{100}" =~ /^$code1u$/, "reparse embeded unicode");
+ ok("\x{100}" =~ /^$code1u$/, "reparse embedded unicode");
}
}