[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.

3 files changed, 15 insertions, 5 deletions

diff --git a/pp_ctl.c b/pp_ctl.c
index 601a25c5ce..244445281e 100644
--- 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 309ee6d279..ad292d1a5e 100644
--- 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 10c12b8042..1509e2d995 100644
--- 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