require './test.pl';
}
-plan tests => 699; # Update this when adding/deleting tests.
+plan tests => 712; # Update this when adding/deleting tests.
run_tests() unless caller;
local $SIG{__WARN__} = sub {};
my $str = "\x{110000}";
- # No non-unicode code points match any Unicode property, even inverse
- # ones
- unlike($str, qr/\p{ASCII_Hex_Digit=True}/, "Non-Unicode doesn't match \\p{}");
- unlike($str, qr/\p{ASCII_Hex_Digit=False}/, "Non-Unicode doesn't match \\p{}");
- like($str, qr/\P{ASCII_Hex_Digit=True}/, "Non-Unicode matches \\P{}");
- like($str, qr/\P{ASCII_Hex_Digit=False}/, "Non-Unicode matches \\P{}");
+ unlike($str, qr/\p{ASCII_Hex_Digit=True}/, "Non-Unicode doesn't match \\p{AHEX=True}");
+ like($str, qr/\p{ASCII_Hex_Digit=False}/, "Non-Unicode matches \\p{AHEX=False}");
+ like($str, qr/\P{ASCII_Hex_Digit=True}/, "Non-Unicode matches \\P{AHEX=True}");
+ unlike($str, qr/\P{ASCII_Hex_Digit=False}/, "Non-Unicode matches \\P{AHEX=FALSE}");
}
{
"abc" =~ qr/(?<$char>abc)/;
EOP
utf8::encode($prog);
- fresh_perl_like($prog, qr!Group name must start with a non-digit word character!, "",
+ fresh_perl_like($prog, qr!Group name must start with a non-digit word character!, {},
sprintf("'U+%04X not legal IDFirst'", ord($char)));
}
}
pass('no crash with /@a/ when array has nonexistent elems');
}
+ {
+ is runperl(prog => 'delete $::{qq-\cR-}; //; print qq-ok\n-'),
+ "ok\n",
+ 'deleting *^R does not result in crashes';
+ no warnings 'once';
+ *^R = *caretRglobwithnoscalar;
+ "" =~ /(?{42})/;
+ is $^R, 42, 'assigning to *^R does not result in a crash';
+ is runperl(
+ stderr => 1,
+ prog => 'eval q|'
+ .' q-..- =~ /(??{undef *^R;q--})(?{42})/; '
+ .' print qq-$^R\n-'
+ .'|'
+ ),
+ "42\n",
+ 'undefining *^R within (??{}) does not result in a crash';
+ }
+
+ {
+ # [perl #120446]
+ # this code should be virtually instantaneous. If it takes 10s of
+ # seconds, there a bug in intuit_start.
+ # (this test doesn't actually test for slowness - that involves
+ # too much danger of false positives on loaded machines - but by
+ # putting it here, hopefully someone might notice if it suddenly
+ # runs slowly)
+ my $s = ('a' x 1_000_000) . 'b';
+ my $i = 0;
+ for (1..10_000) {
+ pos($s) = $_;
+ $i++ if $s =~/\Gb/g;
+ }
+ is($i, 0, "RT 120446: mustn't run slowly");
+ }
+
+ # These are based on looking at the code in regcomp.c
+ # We don't look for specific code, just the existence of an SSC
+ foreach my $re (qw( qr/a?c/
+ qr/a?c/i
+ qr/[ab]?c/
+ qr/\R?c/
+ qr/\d?c/d
+ qr/\w?c/l
+ qr/\s?c/a
+ qr/[[:alpha:]]?c/u
+ )) {
+ SKIP: {
+ skip "no re-debug under miniperl" if is_miniperl;
+ my $prog = <<"EOP";
+use re qw(Debug COMPILE);
+$re;
+EOP
+ fresh_perl_like($prog, qr/synthetic stclass/, { stderr=>1 }, "$re generates a synthetic start class");
+ }
+ }
+
+ {
+ like "\x{AA}", qr/a?[\W_]/d, "\\W with /d synthetic start class works";
+ }
+
+
+
} # End of sub run_tests
1;