Flatten vstrings modified in place

A substitution forces its target to a string upon successful substitu-
tion, even if the substitution did nothing:

$ ./perl -Ilib -le '$a = *f; $a =~ s/f/f/; print ref \$a'
SCALAR

Notice that $a is no longer a glob after s///.

But vstrings are different:

$ ./perl -Ilib -le '$a = v102; $a =~ s/f/f/; print ref \$a'
VSTRING

I fixed this in 5.16 (1e6bda9) for those cases where the vstring ends
up with a value that doesn’t correspond to the actual string:

$ ./perl -Ilib -le '$a = v102; $a =~ s/f/o/; print ref \$a'
SCALAR

It works through vstring set-magic, that does the check and removes
the magic if it doesn’t match.

I did it that way because I couldn’t think of any other way to fix
bug #29070, and I didn’t realise at the time that I hadn’t fixed
all the bugs.

By making SvTHINKFIRST true on a vstring, we force it through
sv_force_normal before any in-place string operations.  We can also
make sv_force_normal handle vstrings as well.  This fixes all the lin-
gering-vstring-magic bugs in just two lines, making the vstring set-
magic (which is also slow) redundant.  It also allows the special case
in sv_setsv_flags to be removed.

Or at least that was what I had hoped.

It turns out that pp_subst, twists and turns in tortuous ways, and
needs special treatment for things like this.

And do_trans functions wasn’t checking SvTHINKFIRST when arguably it
should have.

I tweaked sv_2pv{utf8,byte} to avoid copying magic variables that do
not need copying.

doop.c

@@ -641,7 +641,7 @@ Perl_do_trans(pTHX_ SV *sv)
     if (!len)
 	return 0;
     if (!(PL_op->op_private & OPpTRANS_IDENTICAL)) {
-	if (!SvPOKp(sv))
+	if (!SvPOKp(sv) || SvTHINKFIRST(sv))
 	    (void)SvPV_force_nomg(sv, len);
 	(void)SvPOK_only_UTF8(sv);
     }

embed.fnc

@@ -775,7 +775,6 @@ p	|int	|magic_settaint	|NN SV* sv|NN MAGIC* mg
 p	|int	|magic_setuvar	|NN SV* sv|NN MAGIC* mg
 p	|int	|magic_setvec	|NN SV* sv|NN MAGIC* mg
 p	|int	|magic_setutf8	|NN SV* sv|NN MAGIC* mg
-p	|int	|magic_setvstring|NN SV* sv|NN MAGIC* mg
 p	|int	|magic_set_all_env|NN SV* sv|NN MAGIC* mg
 p	|U32	|magic_sizepack	|NN SV* sv|NN MAGIC* mg
 p	|int	|magic_wipepack	|NN SV* sv|NN MAGIC* mg

embed.h

@@ -1152,7 +1152,6 @@
 #define magic_setutf8(a,b)	Perl_magic_setutf8(aTHX_ a,b)
 #define magic_setuvar(a,b)	Perl_magic_setuvar(aTHX_ a,b)
 #define magic_setvec(a,b)	Perl_magic_setvec(aTHX_ a,b)
-#define magic_setvstring(a,b)	Perl_magic_setvstring(aTHX_ a,b)
 #define magic_sizepack(a,b)	Perl_magic_sizepack(aTHX_ a,b)
 #define magic_wipepack(a,b)	Perl_magic_wipepack(aTHX_ a,b)
 #define mg_localize(a,b,c)	Perl_mg_localize(aTHX_ a,b,c)

mg.c

@@ -2325,19 +2325,6 @@ Perl_magic_setvec(pTHX_ SV *sv, MAGIC *mg)
     return 0;
 }
 
-int
-Perl_magic_setvstring(pTHX_ SV *sv, MAGIC *mg)
-{
-    PERL_ARGS_ASSERT_MAGIC_SETVSTRING;
-
-    if (SvPOKp(sv)) {
-	SV * const vecsv = sv_newmortal();
-	scan_vstring(mg->mg_ptr, mg->mg_ptr + mg->mg_len, vecsv);
-	if (sv_eq_flags(vecsv, sv, 0 /*nomg*/)) return 0;
-    }
-    return sv_unmagic(sv, mg->mg_type);
-}
-
 int
 Perl_magic_getdefelem(pTHX_ SV *sv, MAGIC *mg)
 {

mg_raw.h

@@ -68,7 +68,7 @@
       "/* taint 't' Taintedness */" },
     { 'U', "want_vtbl_uvar",
       "/* uvar 'U' Available for use by extensions */" },
-    { 'V', "want_vtbl_vstring | PERL_MAGIC_VALUE_MAGIC",
+    { 'V', "magic_vtable_max | PERL_MAGIC_VALUE_MAGIC",
       "/* vstring 'V' SV was vstring literal */" },
     { 'v', "want_vtbl_vec | PERL_MAGIC_VALUE_MAGIC",
       "/* vec 'v' vec() lvalue */" },

mg_vtable.h

@@ -86,7 +86,6 @@ enum {		/* pass one of these to get_vtbl */
     want_vtbl_utf8,
     want_vtbl_uvar,
     want_vtbl_vec,
-    want_vtbl_vstring,
     magic_vtable_max
 };
 
@@ -120,8 +119,7 @@ EXTCONST char *PL_magic_vtable_names[magic_vtable_max] = {
     "taint",
     "utf8",
     "uvar",
-    "vec",
-    "vstring"
+    "vec"
 };
 #else
 EXTCONST char *PL_magic_vtable_names[magic_vtable_max];
@@ -182,8 +180,7 @@ EXT_MGVTBL PL_magic_vtables[magic_vtable_max] = {
   { Perl_magic_gettaint, Perl_magic_settaint, 0, 0, 0, 0, 0, 0 },
   { 0, Perl_magic_setutf8, 0, 0, 0, 0, 0, 0 },
   { Perl_magic_getuvar, Perl_magic_setuvar, 0, 0, 0, 0, 0, 0 },
-  { Perl_magic_getvec, Perl_magic_setvec, 0, 0, 0, 0, 0, 0 },
-  { 0, Perl_magic_setvstring, 0, 0, 0, 0, 0, 0 }
+  { Perl_magic_getvec, Perl_magic_setvec, 0, 0, 0, 0, 0, 0 }
 };
 #else
 EXT_MGVTBL PL_magic_vtables[magic_vtable_max];
@@ -223,6 +220,5 @@ EXT_MGVTBL PL_magic_vtables[magic_vtable_max];
 #define PL_vtbl_utf8 PL_magic_vtables[want_vtbl_utf8]
 #define PL_vtbl_uvar PL_magic_vtables[want_vtbl_uvar]
 #define PL_vtbl_vec PL_magic_vtables[want_vtbl_vec]
-#define PL_vtbl_vstring PL_magic_vtables[want_vtbl_vstring]
 
 /* ex: set ro: */

pod/perlguts.pod

@@ -1103,7 +1103,7 @@ will be lost.
                                              extensions
  u  PERL_MAGIC_uvar_elem      (none)         Reserved for use by
                                              extensions
- V  PERL_MAGIC_vstring        vtbl_vstring   SV was vstring literal
+ V  PERL_MAGIC_vstring        (none)         SV was vstring literal
  v  PERL_MAGIC_vec            vtbl_vec       vec() lvalue
  w  PERL_MAGIC_utf8           vtbl_utf8      Cached UTF-8 information
  x  PERL_MAGIC_substr         vtbl_substr    substr() lvalue

pp_hot.c

@@ -2116,7 +2116,7 @@ PP(pp_subst)
 
   setup_match:
     s = SvPV_mutable(TARG, len);
-    if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV)
+    if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV || SvVOK(TARG))
 	force_on_match = 1;
 
     /* only replace once? */

proto.h

@@ -2345,12 +2345,6 @@ PERL_CALLCONV int	Perl_magic_setvec(pTHX_ SV* sv, MAGIC* mg)
 #define PERL_ARGS_ASSERT_MAGIC_SETVEC	\
 	assert(sv); assert(mg)
 
-PERL_CALLCONV int	Perl_magic_setvstring(pTHX_ SV* sv, MAGIC* mg)
-			__attribute__nonnull__(pTHX_1)
-			__attribute__nonnull__(pTHX_2);
-#define PERL_ARGS_ASSERT_MAGIC_SETVSTRING	\
-	assert(sv); assert(mg)
-
 PERL_CALLCONV U32	Perl_magic_sizepack(pTHX_ SV* sv, MAGIC* mg)
 			__attribute__nonnull__(pTHX_1)
 			__attribute__nonnull__(pTHX_2);

regen/mg_vtable.pl

@@ -84,7 +84,7 @@ BEGIN
 		    unknown_to_sv_magic => 1 },
      vec => { char => 'v', vtable => 'vec', value_magic => 1,
 	      desc => 'vec() lvalue' },
-     vstring => { char => 'V', value_magic => 1, vtable => 'vstring',
+     vstring => { char => 'V', value_magic => 1,
 		  desc => 'SV was vstring literal' },
      utf8 => { char => 'w', vtable => 'utf8', value_magic => 1,
 	       desc => 'Cached UTF-8 information' },
@@ -142,7 +142,6 @@ BEGIN
 		    cond => '#ifdef USE_LOCALE_COLLATE'},
      'hintselem' => {set => 'sethint', clear => 'clearhint'},
      'hints' => {clear => 'clearhints'},
-     'vstring' => {set => 'setvstring'},
      'checkcall' => {copy => 'copycallchecker'},
 );
 

sv.c

@@ -3035,7 +3035,8 @@ Perl_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *const lp)
 {
     PERL_ARGS_ASSERT_SV_2PVBYTE;
 
-    if ((SvTHINKFIRST(sv) && !SvIsCOW(sv)) || isGV_with_GP(sv)) {
+    if (((SvREADONLY(sv) || SvFAKE(sv)) && !SvIsCOW(sv))
+     || isGV_with_GP(sv) || SvROK(sv)) {
 	SV *sv2 = sv_newmortal();
 	sv_copypv(sv2,sv);
 	sv = sv2;
@@ -3061,7 +3062,8 @@ Perl_sv_2pvutf8(pTHX_ register SV *sv, STRLEN *const lp)
 {
     PERL_ARGS_ASSERT_SV_2PVUTF8;
 
-    if ((SvTHINKFIRST(sv) && !SvIsCOW(sv)) || isGV_with_GP(sv))
+    if (((SvREADONLY(sv) || SvFAKE(sv)) && !SvIsCOW(sv))
+     || isGV_with_GP(sv) || SvROK(sv))
 	sv = sv_mortalcopy(sv);
     else
         SvGETMAGIC(sv);
@@ -3937,12 +3939,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
     stype = SvTYPE(sstr);
     dtype = SvTYPE(dstr);
 
-    if ( SvVOK(dstr) )
-    {
-	/* need to nuke the magic */
-	sv_unmagic(dstr, PERL_MAGIC_vstring);
-    }
-
     /* There's a lot of redundancy below but we're going for speed here */
 
     switch (stype) {
@@ -4719,10 +4715,12 @@ S_sv_release_COW(pTHX_ register SV *sv, const char *pvx, SV *after)
 /*
 =for apidoc sv_force_normal_flags
 
-Undo various types of fakery on an SV: if the PV is a shared string, make
+Undo various types of fakery on an SV, where fakery means
+"more than" a string: if the PV is a shared string, make
 a private copy; if we're a ref, stop refing; if we're a glob, downgrade to
 an xpvmg; if we're a copy-on-write scalar, this is the on-write time when
-we do the copy, and is also used locally.  If C<SV_COW_DROP_PV> is set
+we do the copy, and is also used locally; if this is a
+vstring, drop the vstring magic.  If C<SV_COW_DROP_PV> is set
 then a copy-on-write scalar drops its PV buffer (if any) and becomes
 SvPOK_off rather than making a copy.  (Used where this
 scalar is about to be set to some other value.)  In addition,
@@ -4849,6 +4847,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *const sv, const U32 flags)
 
 	SvREFCNT_dec(temp);
     }
+    else if (SvVOK(sv)) sv_unmagic(sv, PERL_MAGIC_vstring);
 }
 
 /*

sv.h

@@ -348,7 +348,7 @@ perform the upgrade if necessary.  See C<svtype>.
 
 
 
-#define SVf_THINKFIRST	(SVf_READONLY|SVf_ROK|SVf_FAKE)
+#define SVf_THINKFIRST	(SVf_READONLY|SVf_ROK|SVf_FAKE|SVs_RMG)
 
 #define SVf_OK		(SVf_IOK|SVf_NOK|SVf_POK|SVf_ROK| \
 			 SVp_IOK|SVp_NOK|SVp_POK|SVpgv_GP)

t/op/ver.t

@@ -11,7 +11,7 @@ $DOWARN = 1; # enable run-time warnings now
 
 use Config;
 
-plan( tests => 55 );
+plan( tests => 57 );
 
 eval 'use v5.5.640';
 is( $@, '', "use v5.5.640; $@");
@@ -270,6 +270,11 @@ ok( exists $h{chr(65).chr(66).chr(67)}, "v-stringness is engaged for X.Y.Z" );
     is $|, 1, 'clobbering vstrings does not clobber all magic';
 }
 
+$a = v102; $a =~ s/f/f/;
+is ref \$a, 'SCALAR',
+  's/// flattens vstrings even when the subst results in the same value';
+$a = v102; $a =~ y/f/g/;
+is ref \$a, 'SCALAR', 'y/// flattens vstrings';
 
 # The following tests whether v-strings are correctly
 # interpreted by the tokeniser when it's in a XTERMORDORDOR