Create viral value magic

Adds a new SVs_VMG flag + associated macros; use the SvVMAGICAL flag to
fast-path sv_has_valuemagic() if appropriate

Use the sv_has_valuemagic() function to know whether to call
mg_propagate() in sv_setsv_flags()

Author: leonerd

MANIFEST

@@ -5183,6 +5183,7 @@ ext/XS-APItest/t/magic.t			test attaching, finding, and removing magic
 ext/XS-APItest/t/magic_chain.t			test low-level MAGIC chain handling
 ext/XS-APItest/t/magicv2.t			XS::APItest: tests for Magic-v2 related APIs
 ext/XS-APItest/t/magicv2-threads.t		XS::APItest: tests for Magic-v2 related APIs across multiple threads
+ext/XS-APItest/t/magicv2-viral.t		XS::APItest: tests for Magic-v2 related APIs on viral SCALARVALUE
 ext/XS-APItest/t/Markers.pm			Helper for ./blockhooks.t
 ext/XS-APItest/t/mortal_destructor.t		Test mortal_destructor api.
 ext/XS-APItest/t/mro.t				Test mro plugin api

doop.c

@@ -715,6 +715,8 @@ Perl_do_join(pTHX_ SV *sv, SV *delim, SV **mark, SV **sp)
 
     if (TAINTING_get && SvMAGICAL(sv))
         SvTAINTED_off(sv);
+    if(SvMAGICAL(sv)) /* TODO: need more flags */
+        mg_unpropagate(sv);
 
     if (items-- > 0) {
         if (*mark)

dump.c

@@ -1999,6 +1999,8 @@ Perl_do_magicv2_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I
             case MGv2s_SCALARVAR: shapename = "SCALARVAR"; break;
             case MGv2s_ARRAYVAR:  shapename = "ARRAYVAR";  break;
             case MGv2s_HASHVAR:   shapename = "HASHVAR";   break;
+            case MGv2s_SCALARVALUE:
+                                  shapename = "SCALARVALUE"; break;
         }
         if(shapename)
             dump_indent(level, file, "      SHAPE = %s\n", shapename);
@@ -2039,6 +2041,13 @@ Perl_do_magicv2_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I
                     dump_indent(level, file, "      CLEAR\n");
                 break;
             }
+            case MGv2s_SCALARVALUE:
+            {
+                const struct ScalarValueMagicFunctions *funcs = MgSCALARVALUEFUNCS(mg);
+                if(funcs->propagate)
+                    Perl_dump_indent(aTHX_ level, file, "      PROPAGATE\n");
+                break;
+            }
         }
     }
 
@@ -2536,7 +2545,10 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
         /* FALLTHROUGH */
     case SVt_PVMG:
     default:
-        if (SvIsUV(sv) && !(flags & SVf_ROK))	sv_catpvs(d, "IsUV,");
+        if (type <= SVt_PVMG && SvVMAGICAL(sv))
+            sv_catpvs(d, "VMG,");
+        if (SvIsUV(sv) && !(flags & SVf_ROK))
+            sv_catpvs(d, "IsUV,");
         break;
 
     case SVt_PVAV:

embed.fnc

@@ -4190,6 +4190,10 @@ Adp	|void	|vfatal_warner	|U32 err				\
 				|NULLOK va_list *args
 Adp	|char * |vform		|NN const char *pat			\
 				|NULLOK va_list *args
+Cp	|void	|viralmagic_applyto					\
+				|NN SV *dsv
+Cp	|void	|viralmagic_clear
+Cp	|void	|viralmagic_from|NN SV *ssv
 : Used by Data::Alias
 EXp	|void	|vivify_defelem |NN SV *sv
 : Used in pp.c
@@ -4428,6 +4432,9 @@ Cpx	|SV *	|sv_setsv_cow	|NULLOK SV *dsv 			\
 				|NN SV *ssv
 #endif
 #if defined(PERL_CORE)
+p	|void	|mg_propagate	|NN SV *ssv				\
+				|NULLOK SV *dsv
+p	|void	|mg_unpropagate |NN SV *sv
 p	|void	|opslab_force_free					\
 				|NN OPSLAB *slab
 p	|void	|opslab_free	|NN OPSLAB *slab
@@ -4437,6 +4444,8 @@ p	|void	|parser_free_nexttoke_ops				\
 				|NN yy_parser *parser			\
 				|NN OPSLAB *slab
 RTi	|bool	|should_warn_nl |NN const char *pv
+p	|bool	|sv_has_valuemagic					\
+				|NN const SV *sv
 # if defined(PERL_DEBUG_READONLY_OPS)
 ep	|void	|Slab_to_ro	|NN OPSLAB *slab
 ep	|void	|Slab_to_rw	|NN OPSLAB * const slab

embed.h

@@ -348,6 +348,42 @@ static const struct ArrayVarMagicFunctions magicfuncs_inc_after_clear_hash = {
     .clear = &magicfunc_inc,
 };
 
+/* we can't make this one `static` because -Wc++-compat gets upset if we do */
+extern const struct ScalarValueMagicFunctions magicfuncs_viral;
+
+static void
+magicfunc_propagate(pTHX_ SV *osv, MAGIC *omg, SV *nsv, MAGIC *nmg)
+{
+    PERL_UNUSED_ARG(osv);
+
+    SV *auxsv = MgAUXSV(omg);
+
+    /* Only add this to nsv if it doesn't already have it
+     * TODO: This is kinda inefficient. We could make it better by storing
+     * all the annotations sorted in order of auxsv address, allowing us to
+     * bail out on average twice as fast. Such a search also gives us the
+     * right insert point to add if absent.
+     * Such logic would involve more deep internal poking at the MAGIC
+     * structure though. */
+
+    for(nmg = sv_magicv2_find_by_funcs(nsv, (const struct MagicFunctions *)&magicfuncs_viral);
+            nmg;
+            nmg = sv_magicv2_findnext_by_funcs(nsv, (const struct MagicFunctions *)&magicfuncs_viral, nmg)) {
+        if(MgAUXSV(nmg) == auxsv)
+            return;
+    }
+
+    sv_magicv2_add(nsv, (const struct MagicFunctions *)&magicfuncs_viral, 0, SvREFCNT_inc(auxsv));
+}
+
+const struct ScalarValueMagicFunctions magicfuncs_viral = {
+    .ver   = 2,
+    .shape = MGv2s_SCALARVALUE,
+    .debug_name = "XS::APItest/viral",
+
+    .propagate = magicfunc_propagate,
+};
+
 static const struct MagicFunctions *S_magicfuncs_by_name(pTHX_ SV *name)
 {
     char *namepv = SvPV_nolen(name);
@@ -363,6 +399,7 @@ static const struct MagicFunctions *S_magicfuncs_by_name(pTHX_ SV *name)
     if(strEQ(namepv, "inc_after_set"))   return (struct MagicFunctions *)&magicfuncs_inc_after_set;
     if(strEQ(namepv, "inc_after_clear_arr"))  return (struct MagicFunctions *)&magicfuncs_inc_after_clear_arr;
     if(strEQ(namepv, "inc_after_clear_hash")) return (struct MagicFunctions *)&magicfuncs_inc_after_clear_hash;
+    if(strEQ(namepv, "viral"))           return (struct MagicFunctions *)&magicfuncs_viral;
     croak("Unrecognised magicfuncs name %" SVf, SVfARG(name));
 }