}
-plan tests => 366; # Update this when adding/deleting tests.
+plan tests => 402; # Update this when adding/deleting tests.
run_tests() unless caller;
}
{
- iseq qr/\b\v$/i, '(?i-xsm:\b\v$)', 'qr/\b\v$/i';
- iseq qr/\b\v$/s, '(?s-xim:\b\v$)', 'qr/\b\v$/s';
- iseq qr/\b\v$/m, '(?m-xis:\b\v$)', 'qr/\b\v$/m';
- iseq qr/\b\v$/x, '(?x-ism:\b\v$)', 'qr/\b\v$/x';
- iseq qr/\b\v$/xism, '(?msix:\b\v$)', 'qr/\b\v$/xism';
- iseq qr/\b\v$/, '(?-xism:\b\v$)', 'qr/\b\v$/';
+ iseq qr/\b\v$/i, '(?^i:\b\v$)', 'qr/\b\v$/i';
+ iseq qr/\b\v$/s, '(?^s:\b\v$)', 'qr/\b\v$/s';
+ iseq qr/\b\v$/m, '(?^m:\b\v$)', 'qr/\b\v$/m';
+ iseq qr/\b\v$/x, '(?^x:\b\v$)', 'qr/\b\v$/x';
+ iseq qr/\b\v$/xism, '(?^msix:\b\v$)', 'qr/\b\v$/xism';
+ iseq qr/\b\v$/, '(?^:\b\v$)', 'qr/\b\v$/';
+ }
+
+ { # Test that charset modifier work, and are interpolated
+ iseq qr/\b\v$/, '(?^:\b\v$)', 'Verify no locale, no unicode_strings gives default modifier';
+ iseq qr/(?l:\b\v$)/, '(?^:(?l:\b\v$))', 'Verify infix l modifier compiles';
+ iseq qr/(?u:\b\v$)/, '(?^:(?u:\b\v$))', 'Verify infix u modifier compiles';
+ iseq qr/(?l)\b\v$/, '(?^:(?l)\b\v$)', 'Verify (?l) compiles';
+ iseq qr/(?u)\b\v$/, '(?^:(?u)\b\v$)', 'Verify (?u) compiles';
+
+ my $dual = qr/\b\v$/;
+ use locale;
+ my $locale = qr/\b\v$/;
+ iseq $locale, '(?^l:\b\v$)', 'Verify has l modifier when compiled under use locale';
+ no locale;
+
+ use feature 'unicode_strings';
+ my $unicode = qr/\b\v$/;
+ iseq $unicode, '(?^u:\b\v$)', 'Verify has u modifier when compiled under unicode_strings';
+ iseq qr/abc$dual/, '(?^u:abc(?^:\b\v$))', 'Verify retains d meaning when interpolated under locale';
+ iseq qr/abc$locale/, '(?^u:abc(?^l:\b\v$))', 'Verify retains l when interpolated under unicode_strings';
+
+ no feature 'unicode_strings';
+ iseq qr/abc$locale/, '(?^:abc(?^l:\b\v$))', 'Verify retains l when interpolated outside locale and unicode strings';
+ iseq qr/def$unicode/, '(?^:def(?^u:\b\v$))', 'Verify retains u when interpolated outside locale and unicode strings';
+
+ use locale;
+ iseq qr/abc$dual/, '(?^l:abc(?^:\b\v$))', 'Verify retains d meaning when interpolated under locale';
+ iseq qr/abc$unicode/, '(?^l:abc(?^u:\b\v$))', 'Verify retains u when interpolated under locale';
}
}
+ { # Some constructs with Latin1 characters cause a utf8 string not to
+ # match itself in non-utf8
+ my $c = "\xc0";
+ my $pattern = my $utf8_pattern = qr/((\xc0)+,?)/;
+ utf8::upgrade($utf8_pattern);
+ ok $c =~ $pattern, "\\xc0 =~ $pattern; Neither pattern nor target utf8";
+ ok $c =~ /$pattern/i, "\\xc0 =~ /$pattern/i; Neither pattern nor target utf8";
+ ok $c =~ $utf8_pattern, "\\xc0 =~ $pattern; pattern utf8, target not";
+ ok $c =~ /$utf8_pattern/i, "\\xc0 =~ /$pattern/i; pattern utf8, target not";
+ utf8::upgrade($c);
+ ok $c =~ $pattern, "\\xc0 =~ $pattern; target utf8, pattern not";
+ ok $c =~ /$pattern/i, "\\xc0 =~ /$pattern/i; target utf8, pattern not";
+ ok $c =~ $utf8_pattern, "\\xc0 =~ $pattern; Both target and pattern utf8";
+ ok $c =~ /$utf8_pattern/i, "\\xc0 =~ /$pattern/i; Both target and pattern utf8";
+ }
+
+ {
+ # Test that a regex followed by an operator and/or a statement modifier work
+ # These tests use string-eval so that it reports a clean error when it fails
+ # (without the string eval the test script might be unparseable)
+
+ # Note: these test check the behaviour that currently is valid syntax
+ # If a new regex modifier is added and a test fails then there is a backwards-compatibilty issue
+ # Note-2: a new deprecate warning was added for this with commit e6897b1a5db0410e387ccbf677e89fc4a1d8c97a
+ # which indicate that this syntax will be removed in 5.16.
+ # When this happens the tests can be removed
+
+ no warnings 'syntax';
+ iseq( eval q#my $r = "a" =~ m/a/lt 2;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by lt");
+ iseq( eval q#my $r = "a" =~ m/a/le 1;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by le");
+ iseq( eval q#my $r = "a" =~ m/a/eq 1;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by eq");
+ iseq( eval q#my $r = "a" =~ m/a/ne 0;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by ne");
+ iseq( eval q#my $r = "a" =~ m/a/and 1;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by and");
+ iseq( eval q#my $r = "a" =~ m/a/unless 0;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by unless");
+ iseq( eval q#my $c = 1; my $r; $r = "a" =~ m/a/while $c--;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by while");
+ iseq( eval q#my $c = 0; my $r; $r = "a" =~ m/a/until $c++;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by until");
+ iseq( eval q#my $r; $r = "a" =~ m/a/for 1;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by for");
+ iseq( eval q#my $r; $r = "a" =~ m/a/foreach 1;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by foreach");
+
+ iseq( eval q#my $t = "a"; my $r = $t =~ s/a//lt 2;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by lt");
+ iseq( eval q#my $t = "a"; my $r = $t =~ s/a//le 1;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by le");
+ iseq( eval q#my $t = "a"; my $r = $t =~ s/a//ne 0;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by ne");
+ iseq( eval q#my $t = "a"; my $r = $t =~ s/a//and 1;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by and");
+ iseq( eval q#my $t = "a"; my $r = $t =~ s/a//unless 0;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by unless");
+
+ iseq( 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");
+ iseq( 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");
+ iseq( eval q#my $r; my $t = "a"; $r = $t =~ s/a//for 1;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by for");
+ iseq( eval q#my $r; my $t = "a"; $r = $t =~ s/a//for 1;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by foreach");
+ }
+
} # End of sub run_tests
1;
https://perl5.git.perl.org / perl5.git / blobdiff