[perl #76814] FETCH called twice - m and s

This fixes m and s. It modifies pp_regcomp to avoid extra magic. It
also corrects a bug in sv_catsv_flags, which would still call
mg_get(ssv) even without the SV_GMAGIC flag set.

diff --git a/pp_ctl.c b/pp_ctl.c
index 601a25c..2444452 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -127,7 +127,7 @@ PP(pp_regcomp)
               sv_setsv(tmpstr, sv);
               continue;
            }
-           sv_catsv(tmpstr, msv);
+           sv_catsv_nomg(tmpstr, msv);
        }
        SvSETMAGIC(tmpstr);
        SP = ORIGMARK;
@@ -219,6 +219,14 @@ PP(pp_regcomp)
                tmpstr = newSVpvn_flags(t, len, SVs_TEMP | SvUTF8(tmpstr));
            }
 
+           /* If it is gmagical, create a mortal copy, but without calling
+              get-magic, as we have already done that. */
+           if(SvGMAGICAL(tmpstr)) {
+               SV *mortalcopy = sv_newmortal();
+               sv_setsv_flags(mortalcopy, tmpstr, 0);
+               tmpstr = mortalcopy;
+           }
+
            if (eng)
                PM_SETRE(pm, CALLREGCOMP_ENG(eng, tmpstr, pm_flags));
            else

diff --git a/sv.c b/sv.c
index 309ee6d..ad292d1 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -4789,7 +4789,7 @@ Perl_sv_catsv_flags(pTHX_ SV *const dsv, register SV *const ssv, const I32 flags
 
    if (ssv) {
        STRLEN slen;
-       const char *spv = SvPV_const(ssv, slen);
+       const char *spv = SvPV_flags_const(ssv, slen, flags);
        if (spv) {
            /*  sutf8 and dutf8 were type bool, but under USE_ITHREADS,
                gcc version 2.95.2 20000220 (Debian GNU/Linux) for

diff --git a/t/op/tie_fetch_count.t b/t/op/tie_fetch_count.t
index 10c12b8..1509e2d 100644 (file)
--- a/t/op/tie_fetch_count.t
+++ b/t/op/tie_fetch_count.t
@@ -7,7 +7,7 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require './test.pl';
-    plan (tests => 92);
+    plan (tests => 94);
 }
 
 use strict;
@@ -146,9 +146,11 @@ $dummy  =  $var ~~    1 ; check_count '~~';
 TODO: {
     local $::TODO = $TODO;
     $dummy  =  $var =~ y/ //; check_count 'y///';
-               /$var/       ; check_count 'm/pattern/';
-              s/$var//      ; check_count 's/pattern//';
 }
+           /$var/       ; check_count 'm/pattern/';
+           /$var foo/   ; check_count 'm/$tied foo/';
+          s/$var//      ; check_count 's/pattern//';
+          s/$var foo//  ; check_count 's/$tied foo//';
           s/./$var/     ; check_count 's//replacement/';
 
 # Dereferencing