view release on metacpan or  search on metacpan

t/re/pat.t  view on Meta::CPAN

    {
        eval {
            my $s = "abcd";
            $s =~ m{([abcd]) (?{ die if $1 eq 'd'; })}gx;
            $s =~ //g;
            $s =~ //g;
            $s =~ //g;
        };
        pass("call to current regex doesn't leak");
    }



    {
        # [perl #130495] /x comment skipping stopped a byte short, leading
        # to assertion failure or 'malformed utf-8 character" warning
        fresh_perl_is(
            "use utf8; m{a#\x{124}}x", '', {wide_chars => 1},
            '[perl #130495] utf-8 character at end of /x comment should not misparse',
        );
    }
    {
        # [perl #130522] causes out-of-bounds read detected by clang with
        # address=sanitized when length of the STCLASS string is greater than
        # length of target string.
        my $re = qr{(?=\0z)\0?z?$}i;
        my($yes, $no) = (1, "");
        for my $test (
            [ $no,  undef,   '<undef>' ],
            [ $no,  '',      '' ],
            [ $no,  "\0",    '\0' ],
            [ $yes, "\0z",   '\0z' ],
            [ $no,  "\0z\0", '\0z\0' ],
            [ $yes, "\0z\n", '\0z\n' ],
        ) {
            my($result, $target, $disp) = @$test;
            no warnings qw/uninitialized/;
            is($target =~ $re, $result, "[perl #130522] with target '$disp'");
        }
    }
    {
	# [perl #129377] backref to an unmatched capture should not cause
	# reading before start of string.
	SKIP: {
	    skip "no re-debug under miniperl" if is_miniperl;
	    my $prog = <<'EOP';
use re qw(Debug EXECUTE);
"x" =~ m{ () y | () \1 }x;
EOP
	    fresh_perl_like($prog, qr{
		\A (?! .* ^ \s+ - )
	    }msx, { stderr => 1 }, "Offsets in debug output are not negative");
	}
    }
    {
        # buffer overflow

        # This test also used to leak - fixed by the commit which added
        # this line.

        fresh_perl_is("BEGIN{\$^H=0x200000}\ns/[(?{//xx",
                      "Unmatched [ in regex; marked by <-- HERE in m/[ <-- HERE (?{/ at (eval 1) line 1.\n",
                      {}, "buffer overflow for regexp component");
    }
    {
        # [perl #129281] buffer write overflow, detected by ASAN, valgrind
        fresh_perl_is('/0(?0)|^*0(?0)|^*(^*())0|/', '', {}, "don't bump whilem_c too much");
    }
    {
        # RT #131893 - fails with ASAN -fsanitize=undefined
        fresh_perl_is('qr/0(0?(0||00*))|/', '', {}, "integer overflow during compilation");
    }

    {
        # RT #131575 intuit skipping back from the end to find the highest
        # possible start point, was potentially hopping back beyond pos()
        # and crashing by calling fbm_instr with a negative length

        my $text = "=t=\x{5000}";
        pos($text) = 3;
        ok(scalar($text !~ m{(~*=[a-z]=)}g), "RT #131575");
    }
    {
        fresh_perl_is('"AA" =~ m/AA{1,0}/','',{},"handle OPFAIL insert properly");
    }
    {
        fresh_perl_is('$_="0\x{1000000}";/^000?\0000/','',{},"dont throw assert errors trying to fbm past end of string");
    }
    {   # [perl $132227]
        fresh_perl_is("('0ba' . ('ss' x 300)) =~ m/0B\\N{U+41}" . $sharp_s x 150 . '/i and print "1\n"',  1,{},"Use of sharp s under /di that changes to /ui");

        # A variation, but as far as khw knows not part of 132227
        fresh_perl_is("'0bssa' =~ m/0B" . $sharp_s . "\\N{U+41}" . '/i and print "1\n"',  1,{},"Use of sharp s under /di that changes to /ui");
    }
    {   # [perl $132164]
        fresh_perl_is('m m0*0+\Rm', "",{},"Undefined behavior in address sanitizer");
    }
    {   # [perl #133642]
        fresh_perl_is('no warnings "experimental::vlb";
                      m/((?<=(0?)))/', "",{},"Was getting 'Double free'");
    }
    {   # [perl #133782]
        # this would panic on DEBUGGING builds
        fresh_perl_is(<<'CODE', "ok\nok\n",{}, 'Bad length magic was left on $^R');
while( "\N{U+100}bc" =~ /(..?)(?{$^N})/g ) {
  print "ok\n" if length($^R)==length("$^R");
}
CODE
    }
    {   # [perl #133871], ASAN/valgrind out-of-bounds access
        fresh_perl_like('qr/(?|(())|())|//', qr/syntax error/, {}, "[perl #133871]");
    }
    {   # [perl #133871], ASAN/valgrind out-of-bounds access
        fresh_perl_like('qr/\p{nv:NAnq}/', qr/Can't find Unicode property definition/, {}, "GH #17367");
    }
    {   # GH #17370, ASAN/valgrind out-of-bounds access
        fresh_perl_like('qr/\p{nv:qnan}/', qr/Can't find Unicode property definition/, {}, "GH #17370");
    }
    {   # GH #17371, segfault
        fresh_perl_like('qr/\p{nv=\\\\\}(?0)|\337ss|\337ss//', qr/Unicode property wildcard not terminated/, {}, "GH #17371");
    }