+ # This test is based on the one directly above, which happened to
+ # leak. Repeat the test, but stripped down to the bare essentials
+ # of the leak, which is to die while executing a regex which is
+ # already the current regex, thus causing the saved outer set of
+ # capture offsets to leak. The test itself doesn't do anything
+ # except sit around hoping not to be triggered by ASan
+ {
+ 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('m/((?<=(0?)))/', "Variable length lookbehind not implemented in regex m/((?<=(0?)))/ at - line 1.",{},"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 #133921], segfault
+ fresh_perl_is('qr\ 40||ß+p00000F00000ù\Q00000ÿ00000x00000x0c0e0\Qx0\Qx0\x{0c!}\;\;î0\x\0ÿÿÿþ\0\0\0ù\Q`\Qx`\0\ 1{0c!}\ 1e;\0\0\0ù\ò`\Qm`\x{0c!}\;\;îçÿ \0\7fç\0\0\0!\0F\ 5\0\0/;îçÿù\Q\0\ 1\0\0x\10ÿÿÿÿ\0\0\0ù\0\0\0\7f`x{0c!}\ 1e;\0\0\0ù\Q`\Qx`\x{c!}\;\;îç!}\;îçÿù\Q\87 \x\0ÿÿÿÿ\0\0>=\Qx`\Qx`\0\0ù\ò`\Qx`\x{0c!};\;îçÿ \0F\ 5\0n0t0\0c \0\80\ 1d;t \0\0\0ù \0\7fç\80\0\0!00000000000000000000000m/00000000000000000000\ e00000000000m/\10\10\10\10\x{){} \10\10\10\10)|\10\10\ 4i', "", {}, "[perl #133921]");
+ fresh_perl_is('\ 4|ß+W0ü0r0\Qx0\Qx0x0c0G00000000000000000O000000000x0x0x0c!}\;îçÿù\Q0 \x\0ÿÿÿÿ\0\0\0ù\Q`\Qx`\0\ 1{0d ;\0\0\0ù\ò`\Qm`\x{0c!}\;\;îçÿ \0\7fç\0\0\0!\0F\ 5\0\0/;îçÿù\Q\0\ 1\0\0x\10ÿÿÿÿ\0\0\0ù\0\0\0\7f`x{0c!}\ 1;\0\0\0ù\Q`\Qq`\x{c!}\;\;îç!}\;îçÿù\Q\87 \x\0ÿÿÿÿ\0\0>=\Qx`\Qx`\0\0ù\ò`\Qx`\x{0c!};\;îçÿ \00000000F\ 5\0m0t0\0c \0\80\ 1d;t \0\0\0ù \0\7fç\80\0\0!00000000000000000000000m/00000000000000000000\ e00000000000m/\10\10\10\10\x{){} \10\10\10\10)|\10\10\ 4\ 4i', "", {}, "[perl #133921]");
+ }
+