develooper Front page | perl.perl5.changes | Postings from January 2019

[perl.git] branch blead updated. v5.29.7-30-gd4c456e337

From:
Tony Cook
Date:
January 29, 2019 23:13
Subject:
[perl.git] branch blead updated. v5.29.7-30-gd4c456e337
Message ID:
E1gocYv-0004zF-2j@git.dc.perl.space
In perl.git, the branch blead has been updated

<https://perl5.git.perl.org/perl.git/commitdiff/d4c456e337e653ae11876241727b563a684dffe7?hp=55e8b15f00b722623914897598815cc9f4a7c34f>

- Log -----------------------------------------------------------------
commit d4c456e337e653ae11876241727b563a684dffe7
Author: Tony Cook <tony@develop-help.com>
Date:   Mon Jan 21 11:41:03 2019 +1100

    (perl #133782) set magic when changing $^R
    
    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.

-----------------------------------------------------------------------

Summary of changes:
 regexec.c  | 17 +++++++++++++----
 t/re/pat.t | 10 +++++++++-
 2 files changed, 22 insertions(+), 5 deletions(-)

diff --git a/regexec.c b/regexec.c
index e425adcc24..fe6e0f560c 100644
--- a/regexec.c
+++ b/regexec.c
@@ -7304,8 +7304,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;
@@ -7480,9 +7483,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;
@@ -8950,8 +8957,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 b9c1e262ca..28a717b676 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 => 851;  # Update this when adding/deleting tests.
+plan tests => 852;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -1958,6 +1958,14 @@ EOP
     {   # [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
+    }
 
 } # End of sub run_tests
 

-- 
Perl5 Master Repository



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About