is($x, '505550555', "Test /o");
}
-
{
my $xyz = 'xyz';
ok "abc" =~ /^abc$|$xyz/, "| after \$";
is($result, "abc:bc", $message);
}
-
{
my $message = "Scalar /g";
$_ = "abcfooabcbar";
is($out, 1, $message);
}
-
{
$_ = 'foobar1 bar2 foobar3 barfoobar5 foobar6';
my @out = /(?<!foo)bar./g;
}
}
-
{
# 20000 nodes, each taking 3 words per string, and 1 per branch
my $long_constant_len = join '|', 12120 .. 32645;
is(qr/abc$unicode/, '(?^l:abc(?^u:\b\v$))', 'Verify retains u when interpolated under locale');
}
-
-
{
my $message = "Look around";
$_ = 'xabcx';
}
}
-
{
# test if failure of patterns returns empty list
my $message = "Failed pattern returns empty list";
is("@_", "", $message);
}
-
{
my $message = '@- and @+ tests';
ok(!defined $+ [2] && !defined $- [2] &&
!defined $+ [4] && !defined $- [4], $message);
-
/.(a)/;
is($#+, 1, $message);
is($#-, 1, $message);
is($#-, 1, $message);
}
-
foreach ('$+[0] = 13', '$-[0] = 13', '@+ = (7, 6, 5)', '@- = qw (foo bar)') {
must_die($_, qr/^Modification of a read-only value attempted/,
'Elements of @- and @+ are read-only');
}
-
{
my $message = '\G testing';
$_ = 'aaa';
ok($str =~ /.\G./ && $& eq 'bc', $message);
}
-
{
my $message = 'pos inside (?{ })';
my $str = 'abcde';
"'abcde|' 'abc' 'de'", $message);
}
-
{
my $message = '\G anchor checks';
my $foo = 'aabbccddeeffgg';
is($1, 'cd', $message);
}
-
{
$_ = '123x123';
my @res = /(\d*|x)/g;
is("@res", "123||x|123|", "0 match in alternation");
}
-
{
my $message = "Match against temporaries (created via pp_helem())" .
" is safe";
is($1, "bar", $message);
}
-
{
my $message = 'package $i inside (?{ }), ' .
'saved substrings and changing $_';
is("@c", ",f,,o,,o, ,b,,a,,r,", $message);
}
-
{
my $message = 'Brackets';
our $brackets;
is($&, "{ and }", $message);
}
-
{
$_ = "a-a\nxbb";
pos = 1;
ok(!m/^-.*bb/mg, '$_ = "a-a\nxbb"; m/^-.*bb/mg');
}
-
{
my $message = '\G anchor checks';
my $text = "aaXbXcc";
ok($text !~ /\GXb*X/g, $message);
}
-
{
$_ = "xA\n" x 500;
unlike($_, qr/^\s*A/m, '$_ = "xA\n" x 500; /^\s*A/m"');
is("@res", "b b", '\b is not special');
}
-
{
my $message = '\S, [\S], \s, [\s]';
my @a = map chr, 0 .. 255;
is("@b", "@c", $message);
}
-
{
# see if backtracking optimization works correctly
my $message = 'Backtrack optimization';
like("\n\n", qr/\n?+ $ \n/x, $message);
}
-
{
package S;
use overload '""' => sub {'Object S'};
::ok('S' -> new =~ /^Object S/, "Object stringification") or diag($message);
}
-
{
my $message = "Test result of match used as match";
ok('a1b' =~ ('xyz' =~ /y/), $message);
is($`, 'a', $message);
}
-
{
my $message = '"1" is not \s';
may_not_warn sub {ok ("1\n" x 102 !~ /^\s*\n/m, $message)}, "$message (did not warn)";
}
-
{
my $message = '\s, [[:space:]] and [[:blank:]]';
my %space = (spc => " ",
}
ok($count < 10, 'RT #3516 C');
}
-
-
-
} # End of sub run_tests
1;
#
sub run_tests {
-
{
my $message = '\C matches octet';
$_ = "a\x{100}b";
is($4, "b", $message);
}
-
-
{
my $message = '\C matches octet';
$_ = "\x{100}";
}
}
-
{
# Japhy -- added 03/03/2001
() = (my $str = "abc") =~ /(...)/;
is($1, "abc", 'Changing subject does not modify $1');
}
-
SKIP:
{
# The trick is that in EBCDIC the explicit numeric range should
unlike("\xce", qr/[I-J]/, '"\xce" !~ /[I-J]/');
}
-
{
ok "\x{ab}" =~ /\x{ab}/, '"\x{ab}" =~ /\x{ab}/ ';
ok "\x{abcd}" =~ /\x{abcd}/, '"\x{abcd}" =~ /\x{abcd}/';
}
-
{
my $message = 'bug id 20001008.001';
}
}
-
{
my $message = 'Test \x escapes';
ok("ba\xd4c" =~ /([a\xd4]+)/ && $1 eq "a\xd4", $message);
ok("ba\x{d4}c" =~ /([a\x{d4}]+)/ && $1 eq "a\xd4", $message);
}
-
-
{
my $message = 'Match code points > 255';
$_ = "abc\x{100}\x{200}\x{300}\x{380}\x{400}defg";
ok($1 eq "\x{200}\x{300}" && length ($1) == 2, $message);
}
-
-
{
my $x = "\x{10FFFD}";
$x =~ s/(.)/$1/g;
ok ord($x) == 0x10FFFD && length($x) == 1, "From Robin Houston";
}
-
{
my %d = (
"7f" => [0, 0, 0],
}
}
-
-
{
# From Japhy
must_warn 'qr/(?c)/', '^Useless \(\?c\)';
'Useless \(\?c\)';
}
-
{
my $message = "/x tests";
$_ = "foo";
--
}
-
{
my $message = "/o feature";
sub test_o {$_ [0] =~ /$_[1]/o; return $1}
}
-
SKIP:
{
## Should probably put in tests for all the POSIX stuff,
is($x, (join "", map {chr} 0x00 .. 0x1F, 0x7F), $message);
}
-
{
# With /s modifier UTF8 chars were interpreted as bytes
my $message = "UTF-8 chars aren't bytes";
is($#a, 12, $message);
}
-
{
my $message = '. matches \n with /s';
my $str1 = "foo\nbar";
@a = $str2 =~ /\C/gs; is(@a, 9, $message); is("@a", "f o o \n $a $b b a r", $message);
}
-
{
no warnings 'digit';
# Check that \x## works. 5.6.1 and 5.005_03 fail some of these.
}
-
{
# High bit bug -- japhy
my $x = "ab\200d";
ok $x =~ /.*?\200/, "High bit fine";
}
-
{
# The basic character classes and Unicode
ok "\x{0100}" =~ /\w/, 'LATIN CAPITAL LETTER A WITH MACRON in /\w/';
ok "\x{1680}" =~ /\s/, 'OGHAM SPACE MARK in /\s/';
}
-
{
my $message = "Folding matches and Unicode";
like("a\x{100}", qr/A/i, $message);
like("\x{100}a", qr/[\x{101}]/i, $message);
}
-
{
use charnames ':full';
my $message = "Folding 'LATIN LETTER A WITH GRAVE'";
like($UPPER, qr/[$lower]/i, $message);
}
-
{
use charnames ':full';
my $message = "GREEK CAPITAL LETTER SIGMA vs " .
'Did not warn [change a5961de5f4215b5c]';
}
-
{
my $message = '\X';
use charnames ':full';
like("!abc!", qr/a\Xc/, $message);
}
-
{
my $message = "Final Sigma";
ok(":$S3:" =~ /:(([$sigma])+):/i && $1 eq $S3 && $2 eq $sigma, $message);
}
-
{
use charnames ':full';
my $message = "Parlez-Vous " .
}
}
-
{
my $message = "Lingering (and useless) UTF8 flag doesn't mess up /i";
my $pat = "ABcde";
like($str, qr/$pat/i, $message);
}
-
{
use charnames ':full';
my $message = "LATIN SMALL LETTER SHARP S " .
qr/[\N{LATIN SMALL LETTER SHARP S}x]/i, $message);
}
-
{
# More whitespace: U+0085, U+2028, U+2029\n";
}
}
-
{
# . with /s should work on characters, as opposed to bytes
my $message = ". with /s works on characters, not bytes";
is($r1, $r2, $message);
}
-
{
my $message = "Unicode lookbehind";
like("A\x{100}B" , qr/(?<=A.)B/, $message);
# but that looks like a typo.
}
-
{
my $message = 'UTF-8 hash keys and /$/';
# http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters
}
}
-
{
my $message = "No SEGV in s/// and UTF-8";
my $s = "s#\x{100}" x 4;
}
}
-
{
my $message = "UTF-8 bug (maybe already known?)";
my $u = "foo";
is($u, "feeber", $message);
}
-
{
my $message = "UTF-8 bug with s///";
# check utf8/non-utf8 mixtures
}
}
-
{
my $message = "qr /.../x";
my $R = qr / A B C # D E/x;
ok("ABCDE" =~ m/($R)/ && $1 eq "ABC", $message);
}
-
-
-
{
local $\;
$_ = 'aaaaaaaaaa';
ok +($a = $_, $a =~ s/[^\d]+/./g), 's/[^\s]/ utf8';
}
-
-
-
{
# Subject: Odd regexp behavior
# From: Markus Kuhn <Markus.Kuhn@cl.cam.ac.uk>
like("\x{2019}", qr/\S/, $message);
}
-
{
# XXX DAPM 13-Apr-06. Recursive split is still broken. It's only luck it
# hasn't been crashing. Disable this test until it is fixed properly.
ok 0, 'cache_re & "(?{": it dumps core in 5.6.1 & 5.8.0';
}
-
{
ok "\x{100}\n" =~ /\x{100}\n$/, "UTF-8 length cache and fbm_compile";
}
-
{
package Str;
use overload q /""/ => sub {${$_ [0]};};
ok $ok, "Trie min count matches";
}
-
{
# TRIE related
# LATIN SMALL/CAPITAL LETTER A WITH MACRON
"COMMON PREFIX TRIEF + LATIN SMALL LETTER SHARP S";
}
-
-
-
{
BEGIN {
unshift @INC, 'lib';
}
-
{
use charnames ':full';
ok "\0" =~ /^\N{NULL}$/, 'Verify that \N{NULL} works; is not confused with an error';
}
-
{
our $brackets;
$brackets = qr{
}
}
-
{
my $s = '123453456';
$s =~ s/(?<digits>\d+)\k<digits>/$+{digits}/;
ok $s eq '123456', 'Named capture (single quotes) s///';
}
-
{
my @ary = (
pack('U', 0x00F1), # n-tilde
is($count, 4, "/.(*PRUNE)/");
}
-
{ # Test the (*SKIP) pattern
our $count = 0;
'aaab' =~ /a+b?(*SKIP)(?{$count++})(*FAIL)/;
is("@res", "aaab aaab", "Adjacent (*SKIP) works as expected");
}
-
{ # Test the (*SKIP) pattern
our $count = 0;
'aaab' =~ /a+b?(*MARK:foo)(*SKIP)(?{$count++})(*FAIL)/;
is("@res", "aaab aaab", "Adjacent (*SKIP) works as expected");
}
-
{ # Test the (*SKIP) pattern
our $count = 0;
'aaab' =~ /a*(*MARK:a)b?(*MARK:b)(*SKIP:a)(?{$count++})(*FAIL)/;
"Adjacent (*MARK:a)b?)(*MARK:x)(*SKIP:a) works as expected");
}
-
{ # Test the (*COMMIT) pattern
our $count = 0;
'aaabaaab' =~ /a+b?(*COMMIT)(?{$count++})(*FAIL)/;
is("@res", "aaab", "Adjacent (*COMMIT) works as expected");
}
-
{
# Test named commits and the $REGERROR var
our $REGERROR;
}
}
-
{
# Test named commits and the $REGERROR var
package Fnorble;
}
}
-
{
# Test named commits and the $REGERROR var
my $message = '$REGERROR';
}
}
-
{
my $message = "Relative Recursion";
my $parens = qr/(\((?:[^()]++|(?-1))*+\))/;
is($count, 1, "Optimiser should have prevented more than one match");
}
-
{
# From Message-ID: <877ixs6oa6.fsf@k75.linux.bogus>
my $dow_name = "nada";
is($dow_name, $time_string, "UTF-8 trie common prefix extraction");
}
-
{
my $v;
($v = 'bar') =~ /(\w+)/g;
'$1 is safe after /g - may fail due to specialized config in pp_hot.c');
}
-
{
my $message = "http://nntp.perl.org/group/perl.perl5.porters/118663";
my $qr_barR1 = qr/(bar)\g-1/;
is($REGERROR, 'foo', $message);
}
-
{
my $message = '\K test';
my $x;
is($x, "aabbccddee", $message);
}
-
{
sub kt {
return '4' if $_[0] eq '09028623';
ok 'boob'=~/( b (??{ $qr }) b )/x && 1, "PL_curpm, nested eval";
}
-
{
use charnames ":full";
ok "\N{ROMAN NUMERAL ONE}" =~ /\p{Alphabetic}/, "I =~ Alphabetic";
ok "\x{1C5}" =~ /\p{TitlecaseLetter}/i, "\\x{1C5} =~ TitlecaseLetter under /i";
}
-
{
# requirement of Unicode Technical Standard #18, 1.7 Code Points
# cf. http://www.unicode.org/reports/tr18/#Supplementary_Characters
}
}
-
{
my $res="";
"Check that (?&..) to a buffer inside a (?|...) goes to the leftmost");
}
-
{
use warnings;
my $message = "ASCII pattern that really is UTF-8";
is("@w", '', $message);
}
-
{
my $message = "Corruption of match results of qr// across scopes";
my $qr = qr/(fo+)(ba+r)/;
is("$1$2", "foobar", $message);
}
-
{
my $message = "HORIZWS";
local $_ = "\t \r\n \n \t".chr(11)."\n";
is($_, "hhHHhHhhHH", $message);
}
-
{
# Various whitespace special patterns
my @h = map {chr $_} 0x09, 0x20, 0xa0, 0x1680, 0x180e, 0x2000,
}
}
-
{
# Check that \\xDF match properly in its various forms
# Test that \xDF matches properly. this is pretty hacky stuff,
}
}
-
{
my $message = "BBC(Bleadperl Breaks CPAN) Today: String::Multibyte";
my $re = qr/(?:[\x00-\xFF]{4})/;
is("@a","$esc$hyp=$hyp=$esc$esc", $message);
}
-
{
# Test for keys in %+ and %-
my $message = 'Test keys in %+ and %-';
is((join ",", sort map "@$_", values %-), ",a", $message);
}
-
{
# length() on captures, the numbered ones end up in Perl_magic_len
my $_ = "aoeu \xe6var ook";
is(length $+{eek}, 4, q[length $+{eek} == length $1]);
}
-
{
my $ok = -1;
is($ok, 1, '$+{x} exists after "foo"=~/(?<x>foo)|bar/');
}
-
{
local $_;
($_ = 'abc') =~ /(abc)/g;
is("$1", 'abc', "/g leads to unsafe match vars: $1");
}
-
{
# Message-ID: <20070818091501.7eff4831@r2d2>
my $str = "";
is(length $str, 0, "Trie scope error, string should be empty");
}
-
{
# more TRIE/AHOCORASICK problems with mixed utf8 / latin-1 and case folding
for my $chr (160 .. 255) {
is($b, $a, "Copy of scalar used for postponed subexpression");
}
-
{
our @ctl_n = ();
our @plus = ();
is("@plus", "bla blubb", '$+ inside of (?{}) works as expected');
}
-
SKIP: {
# XXX: This set of tests is essentially broken, POSIX character classes
# should not have differing definitions under Unicode.
'IsPunct agrees with [:punct:] with explicit Latin1');
}
-
{
# Tests for [#perl 71942]
our $count_a;
#
sub run_tests {
-
-
-
like("A \x{263a} B z C", qr/A . B (??{ "z" }) C/,
"Match UTF-8 char in presence of (??{ }); Bug 20000731.001");
-
-
{
-
no warnings 'uninitialized';
ok(undef =~ /^([^\/]*)(.*)$/, "Used to cause a SEGV; Bug 20001021.005");
}
}
}
-
{
-
-
# Fist half of the bug.
my $message = 'HEBREW ACCENT QADMA matched by .*; Bug 20001028.003';
my $X = chr (1448);
is(ord $X, 1488, $message);
}
-
{
-
my $message = 'Repeated s///; Bug 20001108.001';
my $X = "Szab\x{f3},Bal\x{e1}zs";
my $Y = $X;
is($X, "Szab\x{f3},Bal\x{e1}zs", $message);
}
-
{
-
my $message = 's/// on UTF-8 string; Bug 20000517.001';
my $x = "\x{100}A";
$x =~ s/A/B/;
is(length $x, 2, $message);
}
-
{
-
my $message = '\C and É; Bug 20001230.002';
ok("École" =~ /^\C\C(.)/ && $1 eq 'c', $message);
like("École", qr/^\C\C(c)/, $message);
}
-
{
# The original bug report had 'no utf8' here but that was irrelevant.
like($a, qr/\w/, $message); # used to core dump.
}
-
{
-
my $message = '/g in scalar context; Bug 20010410.006';
for my $rx ('/(.*?)\{(.*?)\}/csg',
'/(.*?)\{(.*?)\}/cg',
}
{
-
# Amazingly vertical tabulator is the same in ASCII and EBCDIC.
for ("\n", "\t", "\014", "\r") {
unlike($_, qr/[[:print:]]/, sprintf "\\%03o not in [[:print:]]; Bug 20010619.003", ord $_);
}
}
-
-
{
# [ID 20010814.004] pos() doesn't work when using =~m// in list context
is("$a $b $c", 'ba:ba ad:ae 10', "pos() works with () = m//; Bug 20010814.004");
}
-
{
# [ID 20010407.006] matching utf8 return values from
# functions does not work
ok $x =~ /.*?\200/, "High bit fine";
}
-
{
my $message = 'UTF-8 hash keys and /$/';
# http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters
}
}
-
{
-
my $message = "s///eg [change 13f46d054db22cf4]; Bug 20020124.005";
for my $char ("a", "\x{df}", "\x{100}") {
}
}
-
{
-
my $message = "Correct pmop flags checked when empty pattern; Bug 20020412.005";
# Requires reuse of last successful pattern.
is($result, $num, $message);
}
-
{
-
my $message = 'UTF-8 regex matches above 32k; Bug 20020630.002';
for (['byte', "\x{ff}"], ['utf8', "\x{1ff}"]) {
my ($type, $char) = @$_;
ok $ok && $ord == 0x100 && $len == 4, "No panic: end_shift [change 0e933229fa758625]";
}
-
{
-
our $a = "x\x{100}";
chop $a; # Leaves the UTF-8 flag
$a .= "y"; # 1 byte before 'y'.
{
-
my $message = 'UTF-8 matching; Bug 15397';
like("\x{100}", qr/\x{100}/, $message);
like("\x{100}", qr/(\x{100})/, $message);
like("\x{100}\x{100}", qr/(\x{100})(\x{100})/, $message);
}
-
{
-
my $message = 'Neither ()* nor ()*? sets $1 when matched 0 times; Bug 7471';
local $_ = 'CD';
ok(/(AB)*?CD/ && !defined $1, $message);
ok(/(AB)*CD/ && !defined $1, $message);
}
-
{
-
my $message = "Caching shouldn't prevent match; Bug 3547";
my $pattern = "^(b+?|a){1,2}c";
ok("bac" =~ /$pattern/ && $1 eq 'a', $message);
ok("bbbbac" =~ /$pattern/ && $1 eq 'a', $message);
}
-
-
{
-
-
ok("\x{100}" =~ /(.)/, '$1 should keep UTF-8 ness; Bug 18232');
is($1, "\x{100}", '$1 is UTF-8; Bug 18232');
{ 'a' =~ /./; }
isnt($1, "\xC4\x80", '$1 is not non-UTF-8; Bug 18232');
}
-
{
-
my $message = "Optimizer doesn't prematurely reject match; Bug 19767";
use utf8;
like("0", qr/\p{N}+\z/, $message); # Variant.
}
-
{
-
my $message = "(??{ }) doesn't return stale values; Bug 20683";
our $p = 1;
foreach (1, 2, 3, 4) {
is($p, 5, $message);
}
-
{
# Subject: Odd regexp behavior
# From: Markus Kuhn <Markus.Kuhn@cl.cam.ac.uk>
like("\x{2019}", qr/\S/, $message);
}
-
{
-
my $message = "(??{ .. }) in split doesn't corrupt its stack; Bug 21411";
our $i;
is('-1-3-5-', join('', split /((??{$i++}))/, '-1-3-5-'), $message);
is("@_", "a|b|c", $message);
}
-
{
# XXX DAPM 13-Apr-06. Recursive split is still broken. It's only luck it
# hasn't been crashing. Disable this test until it is fixed properly.
ok 0, 'cache_re & "(?{": it dumps core in 5.6.1 & 5.8.0';
}
-
{
-
$_ = "code: 'x' { '...' }\n"; study;
my @x; push @x, $& while m/'[^\']*'/gx;
local $" = ":";
is("@x", "'x':'...'", "Parse::RecDescent triggered infinite loop; Bug 17757");
}
-
{
-
sub func ($) {
ok("a\nb" !~ /^b/, "Propagated modifier; $_[0]; Bug 22354");
ok("a\nb" =~ /^b/m, "Propagated modifier; $_[0] - with /m; Bug 22354");
$_ = "x"; /x(?{func "in multiline regexp"})/m;
}
-
{
-
$_ = "abcdef\n";
my @x = m/./g;
is("abcde", $`, 'Global match sets $`; Bug 19049');
}
-
{
# [perl #23769] Unicode regex broken on simple example
# regrepeat() didn't handle UTF-8 EXACT case right.
unlike("\xc4\xc4\xc4", qr/(\x{100}++)/, $message);
}
-
{
# perl panic: pp_match start/end pointers
'Captures can move backwards in string; Bug 25269');
}
-
{
# \cA not recognized in character classes
like("a\cAb", qr/\cA/, '\cA in pattern; Bug 27940');
unlike("ab", qr/a\cIb/x, '\cI in pattern; Bug 27940');
}
-
{
# perl #28532: optional zero-width match at end of string is ignored
'Optional zero-width match at end of string; Bug 28532');
}
-
-
{
-
my $utf8 = "\xe9\x{100}"; chop $utf8;
my $latin1 = "\xe9";
like($latin1, qr/(abc|$utf8)/i, "latin/utf8 trie runtime; Bug 36207");
}
-
{
-
my $s = "abcd";
$s =~ /(..)(..)/g;
$s = $1;
"Assigning to original string does not corrupt match vars; Bug 37038");
}
-
{
{
package wooosh;
"change e26a497577f3ce7b didn't affect sub calls for some reason";
}
-
{
local $::TODO = "See changes 26925-26928, which reverted change 26410";
{
}
}
-
SKIP:
{
-
skip "In EBCDIC" if $IS_EBCDIC;
no warnings 'utf8';
$_ = pack 'U0C2', 0xa2, 0xf8; # Ill-formed UTF-8
"Ill-formed UTF-8 doesn't match NUL in class; Bug 37836";
}
-
{
# chr(65535) should be allowed in regexes
is($s, "\x{ffff}", "U+FFFF, NBOUND; Bug 38293");
}
-
{
-
# The printing characters
my @chars = ("A" .. "Z");
ok(defined $1 && length ($1) == $size, '$1 is correct size; Bug 39583');
}
-
{
-
like("\0-A", qr/\c@-A/, '@- should not be interpolated in a pattern; Bug 27940');
like("\0\0A", qr/\c@+A/, '@+ should not be interpolated in a pattern; Bug 27940');
like("X\@-A", qr/X@-A/, '@- should not be interpolated in a pattern; Bug 27940');
like("A@-B", qr/A@{-}B/x, 'Interpolation of @- in /@{-}/x; Bug 27940');
}
-
{
-
my $s = 'foo bar baz';
my (@k, @v, @fetch, $res);
my $count = 0;
is($@, '', 'lvalue $+ {...} should not throw an exception; Bug 50496');
}
-
{
#
# Almost the same as the block above, except that the capture is nested.
is($@, '', 'lvalue $+ {...} should not throw an exception; Bug 50496');
}
-
{
-
my $str = 'abc';
my $count = 0;
my $mval = 0;
is($count, 1, 'Should have matched once only; Bug 36046');
}
-
-
-
{
-
my $message = '/m in precompiled regexp; Bug 40684';
my $s = "abc\ndef";
my $rex = qr'^abc$'m;
ok($s =~ m/^abc$/m, $message);
}
-
{
-
my $message = '(?: ... )? should not lose $^R; Bug 36909';
$^R = 'Nothing';
{
is($^R, 'Nothing', $message);
}
-
{
-
my $message = 'Match is linear, not quadratic; Bug 22395';
our $count;
for my $l (10, 100, 1000) {
}
}
-
{
-
my $message = '@-/@+ should not have undefined values; Bug 22614';
local $_ = 'ab';
our @len = ();
is("@len", "2 2 2", $message);
}
-
{
-
my $message = '$& set on s///; Bug 18209';
my $text = ' word1 word2 word3 word4 word5 word6 ';
is($text, ' word2 word4 word6 ', $message);
}
-
{
# RT#6893
is("@res", "A B C", "/g pattern shouldn't infinite loop; Bug 6893");
}
-
-
{
-
# No optimizer bug
my @tails = ('', '(?(1))', '(|)', '()?');
my @quants = ('*','+');
$doit -> (\@dpats, @dstrs);
}
-
-
{
-
# [perl #45605] Regexp failure with utf8-flagged and byte-flagged string
my $utf_8 = "\xd6schel";
}
}
-
{
-
my $message = '$REGMARK in replacement; Bug 49190';
our $REGMARK;
my $_ = "A";
is($_, "ZYX", $message);
}
-
{
-
my $message = 'Substitution evaluation in list context; Bug 52658';
my $reg = '../xxx/';
my @te = ($reg =~ m{^(/?(?:\.\./)*)},
}
{
-
my $a = "xyzt" x 8192;
like($a, qr/\A(?>[a-z])*\z/,
'(?>) does not cause wrongness on long string; Bug 60034');
'(?>) does not cause wrongness on long string with UTF-8; Bug 60034');
}
-
#
# Keep the following tests last -- they may crash perl
#
is($x, 'ab cd', $message);
}
-
{
-
-
ok (("a" x (2 ** 15 - 10)) =~ /^()(a|bb)*$/, "Recursive stack cracker; Bug 24274");
ok ((q(a)x 100) =~ /^(??{'(.)'x 100})/,
"Regexp /^(??{'(.)'x 100})/ crashes older perls; Bug 24274");
}
-
{
# [perl #45337] utf8 + "[a]a{2}" + /$.../ = panic: sv_len_utf8 cache
like("aaa", qr/$s/, $message);
}
{
-
my $message = "Check if tree logic breaks \$^R; Bug 57042";
my $cond_re = qr/\s*
\s* (?:
ok $2 eq "B";
}
-
-
# This only works under -DEBUGGING because it relies on an assert().
{
-
# Check capture offset re-entrancy of utf8 code.
sub fswash { $_[0] =~ s/([>X])//g; }
is($k2, "\x{2022}", "utf8::SWASHNEW doesn't cause capture leaks; Bug 60508");
}
-
{
# minimal CURLYM limited to 32767 matches
my @pat = (
}
{
-
my $message
= 'utf8 =~ /trie/ where trie matches a continuation octet; Bug 70998';
https://perl5.git.perl.org / perl5.git / commitdiff