BEGIN {
chdir 't' if -d 't';
@INC = ('../lib','.');
- do "re/ReTest.pl" or die $@;
+ require './test.pl';
}
-plan tests => 433; # Update this when adding/deleting tests.
+plan tests => 449; # Update this when adding/deleting tests.
run_tests() unless caller;
# next three tests will fail if you should have picked up a lower-than-
# default value for $reg_infty from Config.pm, but have not.
- eval_ok q (('aaa' =~ /(a{1,$::reg_infty_m})/)[0] eq 'aaa'), $message;
- eval_ok q (('a' x $::reg_infty_m) =~ /a{$::reg_infty_m}/), $message;
- eval_ok q (('a' x ($::reg_infty_m - 1)) !~ /a{$::reg_infty_m}/), $message;
+ is(eval q{('aaa' =~ /(a{1,$::reg_infty_m})/)[0]}, 'aaa', $message);
+ is($@, '', $message);
+ is(eval q{('a' x $::reg_infty_m) =~ /a{$::reg_infty_m}/}, 1, $message);
+ is($@, '', $message);
+ isnt(q{('a' x ($::reg_infty_m - 1)) !~ /a{$::reg_infty_m}/}, 1, $message);
+ is($@, '', $message);
+
eval "'aaa' =~ /a{1,$::reg_infty}/";
- like($@, /^\QQuantifier in {,} bigger than/, $message);
+ like($@, qr/^\QQuantifier in {,} bigger than/, $message);
eval "'aaa' =~ /a{1,$::reg_infty_p}/";
like($@, qr/^\QQuantifier in {,} bigger than/, $message);
}
unlike("b$a=", qr/a$a=/, $message);
like("b$a=", qr/ba+=/, $message);
- like("ba$a=", /b(?:a|b)+=/, $message);
+ like("ba$a=", qr/b(?:a|b)+=/, $message);
}
}
{
my $message = '"1" is not \s';
- may_not_warn sub {ok ("1\n" x 102 !~ /^\s*\n/m, $message)}, "$message (did not warn)";
+ warning_is(sub {unlike("1\n" x 102, qr/^\s*\n/m, $message)},
+ undef, "$message (did not warn)");
}
{
}
{
- use charnames ":full";
- # Delayed interpolation of \N'
- my $r1 = qr/\N{THAI CHARACTER SARA I}/;
- my $s1 = "\x{E34}\x{E34}\x{E34}\x{E34}";
-
- # Bug #56444
- ok $s1 =~ /$r1+/, 'my $r1 = qr/\N{THAI CHARACTER SARA I}/; my $s1 = "\x{E34}\x{E34}\x{E34}\x{E34}; $s1 =~ /$r1+/';
-
- # Bug #62056
- ok "${s1}A" =~ m/$s1\N{LATIN CAPITAL LETTER A}/, '"${s1}A" =~ m/$s1\N{LATIN CAPITAL LETTER A}/';
-
- ok "abbbbc" =~ m/\N{1}/ && $& eq "a", '"abbbbc" =~ m/\N{1}/ && $& eq "a"';
- ok "abbbbc" =~ m/\N{3,4}/ && $& eq "abbb", '"abbbbc" =~ m/\N{3,4}/ && $& eq "abbb"';
- }
-
- {
- use charnames ":full";
- my $message = '[perl #74982] Period coming after \N{}';
- ok("\x{ff08}." =~ m/\N{FULLWIDTH LEFT PARENTHESIS}./ && $& eq "\x{ff08}.", $message);
- ok("\x{ff08}." =~ m/[\N{FULLWIDTH LEFT PARENTHESIS}]./ && $& eq "\x{ff08}.", $message);
- }
- {
my $n= 50;
# this must be a high number and go from 0 to N, as the bug we are looking for doesn't
# seem to be predictable. Slight changes to the test make it fail earlier or later.
SKIP: { # Some constructs with Latin1 characters cause a utf8 string not
# to match itself in non-utf8
- if ($IS_EBCDIC) {
+ if ($::IS_EBCDIC) {
skip "Needs to be customized to run on EBCDIC", 6;
}
my $c = "\xc0";
}
SKIP: { # Make sure can override the formatting
- if ($IS_EBCDIC) {
+ if ($::IS_EBCDIC) {
skip "Needs to be customized to run on EBCDIC", 2;
}
use feature 'unicode_strings';
# which indicate that this syntax will be removed in 5.16.
# When this happens the tests can be removed
- no warnings 'syntax';
- is(eval q#my $r = "a" =~ m/a/lt 2;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by lt");
- is(eval q#my $r = "a" =~ m/a/le 1;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by le");
- is(eval q#my $r = "a" =~ m/a/eq 1;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by eq");
- is(eval q#my $r = "a" =~ m/a/ne 0;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by ne");
- is(eval q#my $r = "a" =~ m/a/and 1;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by and");
- is(eval q#my $r = "a" =~ m/a/unless 0;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by unless");
- is(eval q#my $c = 1; my $r; $r = "a" =~ m/a/while $c--;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by while");
- is(eval q#my $c = 0; my $r; $r = "a" =~ m/a/until $c++;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by until");
- is(eval q#my $r; $r = "a" =~ m/a/for 1;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by for");
- is(eval q#my $r; $r = "a" =~ m/a/foreach 1;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by foreach");
-
- is(eval q#my $t = "a"; my $r = $t =~ s/a//lt 2;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by lt");
- is(eval q#my $t = "a"; my $r = $t =~ s/a//le 1;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by le");
- is(eval q#my $t = "a"; my $r = $t =~ s/a//ne 0;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by ne");
- is(eval q#my $t = "a"; my $r = $t =~ s/a//and 1;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by and");
- is(eval q#my $t = "a"; my $r = $t =~ s/a//unless 0;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by unless");
-
- is(eval q#my $c = 1; my $r; my $t = "a"; $r = $t =~ s/a//while $c--;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by while");
- is(eval q#my $c = 0; my $r; my $t = "a"; $r = $t =~ s/a//until $c++;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by until");
- is(eval q#my $r; my $t = "a"; $r = $t =~ s/a//for 1;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by for");
- is(eval q#my $r; my $t = "a"; $r = $t =~ s/a//for 1;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by foreach");
+ foreach (['my $r = "a" =~ m/a/lt 2', 'm', 'lt'],
+ ['my $r = "a" =~ m/a/le 1', 'm', 'le'],
+ ['my $r = "a" =~ m/a/eq 1', 'm', 'eq'],
+ ['my $r = "a" =~ m/a/ne 0', 'm', 'ne'],
+ ['my $r = "a" =~ m/a/and 1', 'm', 'and'],
+ ['my $r = "a" =~ m/a/unless 0', 'm', 'unless'],
+ ['my $c = 1; my $r; $r = "a" =~ m/a/while $c--', 'm', 'while'],
+ ['my $c = 0; my $r; $r = "a" =~ m/a/until $c++', 'm', 'until'],
+ ['my $r; $r = "a" =~ m/a/for 1', 'm', 'for'],
+ ['my $r; $r = "a" =~ m/a/foreach 1', 'm', 'foreach'],
+
+ ['my $t = "a"; my $r = $t =~ s/a//lt 2', 's', 'lt'],
+ ['my $t = "a"; my $r = $t =~ s/a//le 1', 's', 'le'],
+ ['my $t = "a"; my $r = $t =~ s/a//ne 0', 's', 'ne'],
+ ['my $t = "a"; my $r = $t =~ s/a//and 1', 's', 'and'],
+ ['my $t = "a"; my $r = $t =~ s/a//unless 0', 's', 'unless'],
+
+ ['my $c = 1; my $r; my $t = "a"; $r = $t =~ s/a//while $c--', 's', 'while'],
+ ['my $c = 0; my $r; my $t = "a"; $r = $t =~ s/a//until $c++', 's', 'until'],
+ ['my $r; my $t = "a"; $r = $t =~ s/a//for 1', 's', 'for'],
+ ['my $r; my $t = "a"; $r = $t =~ s/a//for 1', 's', 'foreach'],
+ ) {
+ my $message = sprintf 'regex (%s) followed by $_->[2]',
+ $_->[1] eq 'm' ? 'm//' : 's///';
+ my $code = "$_->[0]; 'eval_ok ' . \$r";
+ my $result = do {
+ no warnings 'syntax';
+ eval $code;
+ };
+ is($@, '', $message);
+ is($result, 'eval_ok 1', $message);
+ }
}
{
https://perl5.git.perl.org / perl5.git / blobdiff