Fix setting magic when changing $^R
This commit is contained in:
parent
640c5891f6
commit
c7f1ea5f86
|
@ -0,0 +1,100 @@
|
||||||
|
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
|
||||||
|
|
|
@ -251,6 +251,9 @@ Patch51: perl-5.29.3-RT-133573-X-fallback-when-platform-specific-techniqu
|
||||||
# in upstream after 5.29.7
|
# in upstream after 5.29.7
|
||||||
Patch52: perl-5.29.7-perl-131562-correct-large-line-numbers-copying-eval-.patch
|
Patch52: perl-5.29.7-perl-131562-correct-large-line-numbers-copying-eval-.patch
|
||||||
|
|
||||||
|
# Fix setting magic when changing $^R, RT#133782, in upstream after 5.29.7
|
||||||
|
Patch53: perl-5.28.1-perl-133782-set-magic-when-changing-R.patch
|
||||||
|
|
||||||
# Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
|
# Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
|
||||||
Patch200: perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch
|
Patch200: perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch
|
||||||
|
|
||||||
|
@ -2856,6 +2859,7 @@ Perl extension for Version Objects
|
||||||
%patch50 -p1
|
%patch50 -p1
|
||||||
%patch51 -p1
|
%patch51 -p1
|
||||||
%patch52 -p1
|
%patch52 -p1
|
||||||
|
%patch53 -p1
|
||||||
%patch200 -p1
|
%patch200 -p1
|
||||||
%patch201 -p1
|
%patch201 -p1
|
||||||
|
|
||||||
|
@ -2901,6 +2905,7 @@ perl -x patchlevel.h \
|
||||||
'Fedora Patch50: Fix a mismatch with a case-insesitive regular expression on a text with ligatures (RT#133756)' \
|
'Fedora Patch50: Fix a mismatch with a case-insesitive regular expression on a text with ligatures (RT#133756)' \
|
||||||
'Fedora Patch51: Fix the interpreter path if procfs is not mounted (RT#133573)' \
|
'Fedora Patch51: Fix the interpreter path if procfs is not mounted (RT#133573)' \
|
||||||
'Fedora Patch52: Fix a crash when parsing #line directives with large numbers in eval (RT#131562)' \
|
'Fedora Patch52: Fix a crash when parsing #line directives with large numbers in eval (RT#131562)' \
|
||||||
|
'Fedora Patch53: Fix setting magic when changing $^R (RT#133782)' \
|
||||||
'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \
|
'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \
|
||||||
'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
|
'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
|
||||||
%{nil}
|
%{nil}
|
||||||
|
@ -5192,6 +5197,7 @@ popd
|
||||||
* Fri Feb 22 2019 Petr Pisar <ppisar@redhat.com> - 4:5.28.1-433
|
* Fri Feb 22 2019 Petr Pisar <ppisar@redhat.com> - 4:5.28.1-433
|
||||||
- Fix a crash when parsing #line directives with large numbers in eval
|
- Fix a crash when parsing #line directives with large numbers in eval
|
||||||
(RT#131562)
|
(RT#131562)
|
||||||
|
- Fix setting magic when changing $^R (RT#133782)
|
||||||
|
|
||||||
* Fri Feb 01 2019 Fedora Release Engineering <releng@fedoraproject.org> - 4:5.28.1-432
|
* Fri Feb 01 2019 Fedora Release Engineering <releng@fedoraproject.org> - 4:5.28.1-432
|
||||||
- Rebuilt for https://fedoraproject.org/wiki/Fedora_30_Mass_Rebuild
|
- Rebuilt for https://fedoraproject.org/wiki/Fedora_30_Mass_Rebuild
|
||||||
|
|
Loading…
Reference in New Issue