}
}
- if (/^ }/) {
+ if (/^ \}/) {
$in_mod_section = 0;
}
}
# Could do this is in a s///mge but seems clearer like this:
$pattern = join '', map {
# If we identify the version condition, take *it* out whatever
- s/\s*# (\$].*)$//
+ s/\s*# (\$\].*)$//
? (eval $1 ? $_ : '')
: $_ # Didn't match, so this line is in
} split /^/, $pattern;
$pat = qr#[\\/]POSIX$#i;
}
else {
- $pat = qr/\.POSIX]/i;
+ $pat = qr/\.POSIX\]/i;
}
like( getcwd(), qr/$pat/, 'getcwd' );
use feature [^\n]+
(?: (?:CORE::)?state sub \w+;
)? \Q$vars\E\(\) = (.*)
-}/s) {
+\}/s) {
::fail($desc);
::diag("couldn't extract line from boilerplate\n");
::diag($got_text);
MDEREF_SHIFT
);
-$VERSION = '1.39';
+$VERSION = '1.40';
use strict;
use vars qw/$AUTOLOAD/;
use warnings ();
# makes use of a lexical var that's not in scope.
# So strip it out.
return $pragmata
- if $use_dec =~ /^use \S+ \(@\{\$args\[0\];}\);/;
+ if $use_dec =~ /^use \S+ \(@\{\$args\[0\];\}\);/;
$use_dec =~ s/^(use|no)\b/$self->keyword($1)/e;
}
'literal -> after an array subscript within ""');
@x = ['string'];
# this used to give "string"
- like("$x[0]-> [0]", qr/^ARRAY\([^)]*\)-> \[0]\z/,
+ like("$x[0]-> [0]", qr/^ARRAY\([^)]*\)-> \[0\]\z/,
'literal -> [0] after an array subscript within ""');
}
eval '{my $x : plugh}';
like $@, qr/^Invalid SCALAR attribute: ["']?plugh["']? at/;
eval '{my ($x,$y) : plugh(})}';
-like $@, qr/^Invalid SCALAR attribute: ["']?plugh\(}\)["']? at/;
+like $@, qr/^Invalid SCALAR attribute: ["']?plugh\(\}\)["']? at/;
# More syntax tests from the attributes manpage
eval 'my $x : switch(10,foo(7,3)) : expensive;';
my $more_args = $3 ? ',1' : '';
eval " &CORE::$o(2$more_args) ";
like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one of(?x:
- ) \[\Q$2\E] at /,
+ ) \[\Q$2\E\] at /,
"&$o with non-ref arg";
eval " &CORE::$o(*STDOUT{IO}$more_args) ";
like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one of(?x:
- ) \[\Q$2\E] at /,
+ ) \[\Q$2\E\] at /,
"&$o with ioref arg";
my $class = ref *DATA{IO};
eval " &CORE::$o(bless(*DATA{IO}, 'hov')$more_args) ";
like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one of(?x:
- ) \[\Q$2\E] at /,
+ ) \[\Q$2\E\] at /,
"&$o with ioref arg with hash overload (which does not count)";
bless *DATA{IO}, $class;
if (do {$2 !~ /&/}) {
$tests++;
eval " &CORE::$o(\\&scriggle$more_args) ";
like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one (?x:
- )of \[\Q$2\E] at /,
+ )of \[\Q$2\E\] at /,
"&$o with coderef arg";
}
}
while (my $v = $vars[0]) {
local $ENV{$v} = $TAINT;
last if eval { `$echo 1` };
- last unless $@ =~ /^Insecure \$ENV\{$v}/;
+ last unless $@ =~ /^Insecure \$ENV\{$v\}/;
shift @vars;
}
is("@vars", "");
is(eval { `$echo 1` }, "1\n");
$ENV{TERM} = 'e=mc2' . $TAINT;
is(eval { `$echo 1` }, undef);
- like($@, qr/^Insecure \$ENV\{TERM}/);
+ like($@, qr/^Insecure \$ENV\{TERM\}/);
}
my $tmp;
is(eval { `$echo 1` }, undef);
# Message can be different depending on whether echo
# is a builtin or not
- like($@, qr/^Insecure (?:directory in )?\$ENV\{PATH}/);
+ like($@, qr/^Insecure (?:directory in )?\$ENV\{PATH\}/);
}
# Relative paths in $ENV{PATH} are always implicitly tainted.
local $ENV{PATH} = '.';
is(eval { `$echo 1` }, undef);
- like($@, qr/^Insecure (?:directory in )?\$ENV\{PATH}/);
+ like($@, qr/^Insecure (?:directory in )?\$ENV\{PATH\}/);
# Backslash should not fool perl into thinking that this is one
# path.
local $ENV{PATH} = '/\:.';
is(eval { `$echo 1` }, undef);
- like($@, qr/^Insecure (?:directory in )?\$ENV\{PATH}/);
+ like($@, qr/^Insecure (?:directory in )?\$ENV\{PATH\}/);
}
SKIP: {
$ENV{'DCL$PATH'} = $TAINT;
is(eval { `$echo 1` }, undef);
- like($@, qr/^Insecure \$ENV\{DCL\$PATH}/);
+ like($@, qr/^Insecure \$ENV\{DCL\$PATH\}/);
SKIP: {
skip q[can't find world-writeable directory to test DCL$PATH], 2
unless $tmp;
$ENV{'DCL$PATH'} = $tmp;
is(eval { `$echo 1` }, undef);
- like($@, qr/^Insecure directory in \$ENV\{DCL\$PATH}/);
+ like($@, qr/^Insecure directory in \$ENV\{DCL\$PATH\}/);
}
$ENV{'DCL$PATH'} = '';
}
ok("A" =~ /\p{$prop}/, "user-defined property: non-tainted case");
$prop = "IsA$TAINT";
eval { "A" =~ /\p{$prop}/};
- like($@, qr/Insecure user-defined property \\p\{main::IsA}/,
+ like($@, qr/Insecure user-defined property \\p\{main::IsA\}/,
"user-defined property: tainted case");
}
eval 'tr/a/\N{KATAKANA LETTER AINU P}/;';
like $@,
- qr/\\N\{KATAKANA LETTER AINU P} must not be a named sequence in transliteration operator/,
+ qr/\\N\{KATAKANA LETTER AINU P\} must not be a named sequence in transliteration operator/,
"Illegal to tr/// named sequence";
eval 'tr/\x{101}-\x{100}//;';
like $@,
- qr/Invalid range "\\x\{0101}-\\x\{0100}" in transliteration operator/,
+ qr/Invalid range "\\x\{0101\}-\\x\{0100\}" in transliteration operator/,
"UTF-8 range with min > max";
SKIP: { # Test literal range end point special handling
# Convert platform-independent values to what is suitable for the
# platform
- $test =~ s/{INFINITY}/$highest_cp/g;
- $test =~ s/{INFINITY_minus_1}/$next_highest_cp/g;
+ $test =~ s/\{INFINITY\}/$highest_cp/g;
+ $test =~ s/\{INFINITY_minus_1\}/$next_highest_cp/g;
$test = "qr/$test/";
my $actual_test = "use re qw(Debug COMPILE); $test";
ok "\N{LONG-STR}" =~ /^\N{LONG-STR}$/i, 'Verify under folding that long string works';
eval '/(?[[\N{EMPTY-STR}]])/';
- ok $@ && $@ =~ /Zero length \\N\{}/;
+ ok $@ && $@ =~ /Zero length \\N\{\}/;
undef $w;
{
# Verify that \ escapes the { after \N, and causes \N to match non-newline
abc\N\{U+BEEF} abc\n{UBEEF} n
-abc\N\{U+BEEF} abc.{UBEEF} y $& abc.{UBEEF}
-[abc\N\{U+BEEF}] - c - \\N in a character class must be a named character
+abc\N\{U+BEEF\} abc.{UBEEF} y $& abc.{UBEEF}
+[abc\N\{U+BEEF\}] - c - \\N in a character class must be a named character
# Verify that \N can be trailing and causes \N to match non-newline
abc\N abcd y $& abcd
eval '{my $x : plǖgh}';
like $@, qr/^Invalid SCALAR attribute: ["']?plǖgh["']? at/;
eval '{my ($x,$y) : plǖgh(})}';
-like $@, qr/^Invalid SCALAR attribute: ["']?plǖgh\(}\)["']? at/;
+like $@, qr/^Invalid SCALAR attribute: ["']?plǖgh\(\}\)["']? at/;
# More syntax tests from the attributes manpage
eval 'my $x : Şʨᚻ(10,ᕘ(7,3)) : 에ㄒ펜ሲ;';
my $E_grave = utf8::unicode_to_native(0xc8);
my $pat = sprintf(
# It took a lot of experimentation to get the backslashes right (khw)
- "Argument \"\\*main::(?:PW\\\\x\\{%x}MPF"
- . "|SKR\\\\x\\{%x}\\\\x\\{%x}\\\\x\\{%x})\" "
+ "Argument \"\\*main::(?:PW\\\\x\\{%x\\}MPF"
+ . "|SKR\\\\x\\{%x\\}\\\\x\\{%x\\}\\\\x\\{%x\\})\" "
. "isn't numeric in sprintf",
$O_grave, $E_grave, $E_grave, $E_grave);
$pat = qr/$pat/;