perl/perl-5.28.1-perl-133782-set-magic-when-changing-R.patch
2019-02-22 14:07:48 +01:00

101 lines
3.3 KiB
Diff

From e6ff24e70ac8055d866eab588c9dfa7dc60adc93 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 21 Jan 2019 11:41:03 +1100
Subject: [PATCH] (perl #133782) set magic when changing $^R
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
The regexp engine sets and restores $^R in a few places, but didn't
mg_set() (SvSETMAGIC()) it at all.
Calls to length() on $^R, both within regexp code blocks and on
a successful match could add utf8 length magic to $^R, and modifying
$^R without mg_set() could leave now invalid length magic.
Petr Písař: Ported to 5.28.1 from upstream's
d4c456e337e653ae11876241727b563a684dffe7.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
regexec.c | 17 +++++++++++++----
t/re/pat.t | 10 +++++++++-
2 files changed, 22 insertions(+), 5 deletions(-)
diff --git a/regexec.c b/regexec.c
index 201d9aa..830a16a 100644
--- a/regexec.c
+++ b/regexec.c
@@ -7319,8 +7319,11 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
PL_op = NULL;
re_sv = NULL;
- if (logical == 0) /* (?{})/ */
- sv_setsv(save_scalar(PL_replgv), ret); /* $^R */
+ if (logical == 0) { /* (?{})/ */
+ SV *replsv = save_scalar(PL_replgv);
+ sv_setsv(replsv, ret); /* $^R */
+ SvSETMAGIC(replsv);
+ }
else if (logical == 1) { /* /(?(?{...})X|Y)/ */
sw = cBOOL(SvTRUE_NN(ret));
logical = 0;
@@ -7495,9 +7498,13 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
{
/* preserve $^R across LEAVE's. See Bug 121070. */
SV *save_sv= GvSV(PL_replgv);
+ SV *replsv;
SvREFCNT_inc(save_sv);
regcpblow(ST.cp); /* LEAVE in disguise */
- sv_setsv(GvSV(PL_replgv), save_sv);
+ /* don't move this initialization up */
+ replsv = GvSV(PL_replgv);
+ sv_setsv(replsv, save_sv);
+ SvSETMAGIC(replsv);
SvREFCNT_dec(save_sv);
}
cur_eval = ST.prev_eval;
@@ -9012,8 +9019,10 @@ NULL
* see code related to PL_replgv elsewhere in this file.
* Yves
*/
- if (oreplsv != GvSV(PL_replgv))
+ if (oreplsv != GvSV(PL_replgv)) {
sv_setsv(oreplsv, GvSV(PL_replgv));
+ SvSETMAGIC(oreplsv);
+ }
}
result = 1;
goto final_exit;
diff --git a/t/re/pat.t b/t/re/pat.t
index 1d98fe7..a96bf56 100644
--- a/t/re/pat.t
+++ b/t/re/pat.t
@@ -23,7 +23,7 @@ BEGIN {
skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader;
skip_all_without_unicode_tables();
-plan tests => 848; # Update this when adding/deleting tests.
+plan tests => 849; # Update this when adding/deleting tests.
run_tests() unless caller;
@@ -1947,6 +1947,14 @@ EOP
{ # [perl $132164]
fresh_perl_is('m m0*0+\Rm', "",{},"Undefined behavior in address sanitizer");
}
+ { # [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
+ }
} # End of sub run_tests
--
2.20.1