Revert "refactor gv_add_by_type"

This reverts commit 819b139db33e2022424694e381422766903d4f65.

This could be repapplied for 5.23.1, with modifications or
additional patches to solve the breakage discussed in RT 123580.

diff --git a/embed.fnc b/embed.fnc
index bf3b35e..faccf49 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -482,7 +482,7 @@ p   |char*  |getenv_len     |NN const char *env_elem|NN unsigned long *len
 pox    |void   |get_db_sub     |NULLOK SV **svp|NN CV *cv
 Ap     |void   |gp_free        |NULLOK GV* gv
 Ap     |GP*    |gp_ref         |NULLOK GP* gp
-Xp     |SV*    |gv_add_by_type_p|NN GV *gv|gv_add_type type
+Ap     |GV*    |gv_add_by_type |NULLOK GV *gv|svtype type
 Apmb   |GV*    |gv_AVadd       |NULLOK GV *gv
 Apmb   |GV*    |gv_HVadd       |NULLOK GV *gv
 Apmb   |GV*    |gv_IOadd       |NULLOK GV* gv

diff --git a/embed.h b/embed.h
index 2342c98..47e45c2 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -187,6 +187,7 @@
 #define grok_number_flags(a,b,c,d)     Perl_grok_number_flags(aTHX_ a,b,c,d)
 #define grok_numeric_radix(a,b)        Perl_grok_numeric_radix(aTHX_ a,b)
 #define grok_oct(a,b,c,d)      Perl_grok_oct(aTHX_ a,b,c,d)
+#define gv_add_by_type(a,b)    Perl_gv_add_by_type(aTHX_ a,b)
 #define gv_autoload_pv(a,b,c)  Perl_gv_autoload_pv(aTHX_ a,b,c)
 #define gv_autoload_pvn(a,b,c,d)       Perl_gv_autoload_pvn(aTHX_ a,b,c,d)
 #define gv_autoload_sv(a,b,c)  Perl_gv_autoload_sv(aTHX_ a,b,c)
@@ -1175,7 +1176,6 @@
 #define get_hash_seed(a)       Perl_get_hash_seed(aTHX_ a)
 #define get_no_modify()                Perl_get_no_modify(aTHX)
 #define get_opargs()           Perl_get_opargs(aTHX)
-#define gv_add_by_type_p(a,b)  Perl_gv_add_by_type_p(aTHX_ a,b)
 #define gv_override(a,b)       Perl_gv_override(aTHX_ a,b)
 #define gv_setref(a,b)         Perl_gv_setref(aTHX_ a,b)
 #define gv_try_downgrade(a)    Perl_gv_try_downgrade(aTHX_ a)

diff --git a/gv.c b/gv.c
index 5a05afa..6801816 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -41,56 +41,53 @@ Perl stores its global variables.
 static const char S_autoload[] = "AUTOLOAD";
 static const STRLEN S_autolen = sizeof(S_autoload)-1;
 
-SV *
-Perl_gv_add_by_type_p(pTHX_ GV *gv, gv_add_type type)
+GV *
+Perl_gv_add_by_type(pTHX_ GV *gv, svtype type)
 {
     SV **where;
-    SV * sv;
-    PERL_ARGS_ASSERT_GV_ADD_BY_TYPE_P;
 
-    if ( SvTYPE((const SV *)gv) != SVt_PVGV
+    if (
+        !gv
+     || (
+            SvTYPE((const SV *)gv) != SVt_PVGV
          && SvTYPE((const SV *)gv) != SVt_PVLV
+        )
     ) {
        const char *what;
-       if (type == GPe_IO) {
+       if (type == SVt_PVIO) {
            /*
             * if it walks like a dirhandle, then let's assume that
             * this is a dirhandle.
             */
            what = OP_IS_DIRHOP(PL_op->op_type) ?
                "dirhandle" : "filehandle";
-       } else if (type == GPe_HV) {
+       } else if (type == SVt_PVHV) {
            what = "hash";
        } else {
-           what = type == GPe_AV ? "array" : "scalar";
+           what = type == SVt_PVAV ? "array" : "scalar";
        }
        /* diag_listed_as: Bad symbol for filehandle */
        Perl_croak(aTHX_ "Bad symbol for %s", what);
     }
 
-    where = (SV **)((Size_t)GvGP(gv)+ (Size_t)type);
-
-    sv = *where;
-    if (!sv) {
-/* this is table of GP members to their SV types, SVt_LAST triggers a panic */
-       static const U8 addtype_to_svtype
-#if PTRSIZE == 8
-             /*gp_sv   , gp_io   , gp_cv   , cvgn/cnt, gp_hv   , gp_av */
-        [6] = {SVt_NULL, SVt_PVIO, SVt_LAST, SVt_LAST, SVt_PVHV, SVt_PVAV};
-#elif PTRSIZE == 4
-             /*gp_sv   , gp_io   , gp_cv   , gp_cvgen, gp_rfcnt, gp_hv   , gp_av */
-        [7] = {SVt_NULL, SVt_PVIO, SVt_LAST, SVt_LAST, SVt_LAST, SVt_PVHV, SVt_PVAV};
-#else
-#  error unknown pointer size
-#endif
-       svtype svtypevar = (svtype)addtype_to_svtype[PTRPTR2IDX(type)];
+    if (type == SVt_PVHV) {
+       where = (SV **)&GvHV(gv);
+    } else if (type == SVt_PVAV) {
+       where = (SV **)&GvAV(gv);
+    } else if (type == SVt_PVIO) {
+       where = (SV **)&GvIOp(gv);
+    } else {
+       where = &GvSV(gv);
+    }
 
-       assert(PTRPTR2IDX(type) < sizeof(addtype_to_svtype));
-       sv = *where = newSV_type(svtypevar);
-       if (type == GPe_AV && memEQs(GvNAME(gv), GvNAMELEN(gv), "ISA"))
-           sv_magic(sv, (SV *)gv, PERL_MAGIC_isa, NULL, 0);
+    if (!*where)
+    {
+       *where = newSV_type(type);
+           if (type == SVt_PVAV && GvNAMELEN(gv) == 3
+            && strnEQ(GvNAME(gv), "ISA", 3))
+           sv_magic(*where, (SV *)gv, PERL_MAGIC_isa, NULL, 0);
     }
-    return sv;
+    return gv;
 }
 
 GV *
@@ -462,60 +459,32 @@ Perl_gv_init_pvn(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, U32 flag
 STATIC void
 S_gv_init_svtype(pTHX_ GV *gv, const svtype sv_type)
 {
-    Size_t addtype;
-#define SGVINIT_SKIP 0xFF
+    PERL_ARGS_ASSERT_GV_INIT_SVTYPE;
+
+    switch (sv_type) {
+    case SVt_PVIO:
+       (void)GvIOn(gv);
+       break;
+    case SVt_PVAV:
+       (void)GvAVn(gv);
+       break;
+    case SVt_PVHV:
+       (void)GvHVn(gv);
+       break;
 #ifdef PERL_DONT_CREATE_GVSV
-#  define SGVINIT_SV GPe_SV
-#else
-#  define SGVINIT_SV SGVINIT_SKIP
+    case SVt_NULL:
+    case SVt_PVCV:
+    case SVt_PVFM:
+    case SVt_PVGV:
+       break;
+    default:
+       if(GvSVn(gv)) {
+           /* Work round what appears to be a bug in Sun C++ 5.8 2005/10/13
+              If we just cast GvSVn(gv) to void, it ignores evaluating it for
+              its side effect */
+       }
 #endif
-    static const U8 svtype2add [] = {
-       /*SVt_NULL,     0 */
-        SGVINIT_SKIP,
-       /*SVt_IV,       1 */
-        SGVINIT_SV,
-       /*SVt_NV,       2 */
-        SGVINIT_SV,
-       /*SVt_PV,       3 */
-        SGVINIT_SV,
-       /*SVt_INVLIST,  4 implemented as a PV */
-        SGVINIT_SV,
-       /*SVt_PVIV,     5 */
-        SGVINIT_SV,
-       /*SVt_PVNV,     6 */
-        SGVINIT_SV,
-       /*SVt_PVMG,     7 */
-        SGVINIT_SV,
-       /*SVt_REGEXP,   8 */
-        SGVINIT_SV,
-       /*SVt_PVGV,     9 */
-        SGVINIT_SKIP,
-       /*SVt_PVLV,     10 */
-        SGVINIT_SV,
-       /*SVt_PVAV,     11 */
-        GPe_AV,
-       /*SVt_PVHV,     12 */
-        GPe_HV,
-       /*SVt_PVCV,     13 */
-        SGVINIT_SKIP,
-       /*SVt_PVFM,     14 */
-        SGVINIT_SKIP,
-       /*SVt_PVIO,     15 */
-        GPe_IO,
-       /*SVt_LAST      keep last in enum. used to size arrays */
-        /* invalid, this is slot 0x10, dont define it so this array is
-        a nice 16 bytes long */
-    };
-    PERL_ARGS_ASSERT_GV_INIT_SVTYPE;
-    addtype = svtype2add[sv_type];
-    if(addtype != SGVINIT_SKIP) {
-        SV ** where = (SV **)((Size_t)GvGP(gv)+ addtype);
-        if (!*where)
-            gv_add_by_type_p(gv, (gv_add_type)addtype);
-    }
-    return;
-#undef SGVINIT_SV
-#undef SGVINIT_SKIP
+    }
 }
 
 static void core_xsub(pTHX_ CV* cv);

diff --git a/gv.h b/gv.h
index 7792017..1d59154 100644 (file)
--- a/gv.h
+++ b/gv.h
@@ -101,9 +101,9 @@ Return the CV from the GV.
 
 #define GvSV(gv)       (GvGP(gv)->gp_sv)
 #ifdef PERL_DONT_CREATE_GVSV
-#define GvSVn(gv)      (GvGP(gv)->gp_sv ? \
-                        GvGP(gv)->gp_sv : \
-                        Perl_gv_add_by_type_p(aTHX_ (gv), GPe_SV))
+#define GvSVn(gv)      (*(GvGP(gv)->gp_sv ? \
+                        &(GvGP(gv)->gp_sv) : \
+                        &(GvGP(gv_SVadd(gv))->gp_sv)))
 #else
 #define GvSVn(gv)      GvSV(gv)
 #endif
@@ -121,22 +121,19 @@ Return the CV from the GV.
    : NULL                                         \
  )
 #define GvIOp(gv)      (GvGP(gv)->gp_io)
-#define GvIOn(gv) \
-       (GvIO(gv) \
-               ? GvIOp(gv) \
-               : (struct io *)Perl_gv_add_by_type_p(aTHX_ (gv), GPe_IO))
+#define GvIOn(gv)      (GvIO(gv) ? GvIOp(gv) : GvIOp(gv_IOadd(gv)))
 
 #define GvFORM(gv)     (GvGP(gv)->gp_form)
 #define GvAV(gv)       (GvGP(gv)->gp_av)
 
 #define GvAVn(gv)      (GvGP(gv)->gp_av ? \
                         GvGP(gv)->gp_av : \
-                        (AV*)Perl_gv_add_by_type_p(aTHX_ (gv), GPe_AV))
+                        GvGP(gv_AVadd(gv))->gp_av)
 #define GvHV(gv)       ((GvGP(gv))->gp_hv)
 
 #define GvHVn(gv)      (GvGP(gv)->gp_hv ? \
                         GvGP(gv)->gp_hv : \
-                        (HV*)Perl_gv_add_by_type_p(aTHX_ (gv), GPe_HV))
+                        GvGP(gv_HVadd(gv))->gp_hv)
 
 #define GvCV(gv)       (0+GvGP(gv)->gp_cv)
 #define GvCV_set(gv,cv)        (GvGP(gv)->gp_cv = (cv))
@@ -286,18 +283,10 @@ Return the CV from the GV.
            : mro_method_changed_in(GvSTASH(gv)) \
     )
 
-/* used by Perl_gv_add_by_type_p for option checking, low bits are free here*/
-typedef enum {
-    GPe_SV = STRUCT_OFFSET(GP, gp_sv),
-    GPe_IO = STRUCT_OFFSET(GP, gp_io),
-    GPe_HV = STRUCT_OFFSET(GP, gp_hv),
-    GPe_AV = STRUCT_OFFSET(GP, gp_av),
-} gv_add_type;
-
-#define gv_AVadd(gv) (Perl_gv_add_by_type_p(aTHX_ (gv), GPe_AV), gv)
-#define gv_HVadd(gv) (Perl_gv_add_by_type_p(aTHX_ (gv), GPe_HV), gv)
-#define gv_IOadd(gv) (Perl_gv_add_by_type_p(aTHX_ (gv), GPe_IO), gv)
-#define gv_SVadd(gv) (Perl_gv_add_by_type_p(aTHX_ (gv), GPe_SV), gv)
+#define gv_AVadd(gv) gv_add_by_type((gv), SVt_PVAV)
+#define gv_HVadd(gv) gv_add_by_type((gv), SVt_PVHV)
+#define gv_IOadd(gv) gv_add_by_type((gv), SVt_PVIO)
+#define gv_SVadd(gv) gv_add_by_type((gv), SVt_NULL)
 
 /*
  * Local variables:

diff --git a/perl.h b/perl.h
index 09a1de2..ebfca35 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -1754,19 +1754,6 @@ typedef UVTYPE UV;
 #define PTR2NV(p)      NUM2PTR(NV,p)
 #define PTR2nat(p)     (PTRV)(p)       /* pointer to integer of PTRSIZE */
 
-
-#if PTRSIZE == 8
-#  define PTRSIZELOG2 3
-#elif PTRSIZE == 4
-#  define PTRSIZELOG2 2
-#  else
-#    error unknown pointer size
-#  endif
-
-/* idx = PTRPTR2IDX(offset)
-        -turn an offset into array of void *s into an index into the array */
-#define PTRPTR2IDX(offset) ((offset) >> PTRSIZELOG2)
-
 /* According to strict ANSI C89 one cannot freely cast between
  * data pointers and function (code) pointers.  There are at least
  * two ways around this.  One (used below) is to do two casts,

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index fb6bdb9..3890ec3 100644 (file)
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -406,19 +406,6 @@ Function either returns an SV * of type AV, which contains the set of
 weakreferences which reference the passed in SV, or a simple RV * which
 is the only weakref to this item.
 
-=item *
-
-C<gv_add_by_type> which was added to public API in 5.11.0 but undocumented and
-shows no CPAN usage has been removed from public API. Please use public API
-C<GvSVn> C<GvIOn> C<GvAVn> and C<GvHVn> for adding elements to a GV.
-
-=item *
-
-C<GvSVn> C<GvIOn> C<GvAVn> and C<GvHVn> have been made rvalues, previously they
-were lvalues. If you are assigning a SV to C<GvSVn> C<GvIOn> C<GvAVn> and
-C<GvHVn> you are leaking memory. If you want an lvalue, use C<GvSV> C<GvIO>
-C<GvAV> and C<GvHV>.
-
 =back
 
 =head1 Selected Bug Fixes

diff --git a/pp_hot.c b/pp_hot.c
index 5557356..4072ab1 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -891,6 +891,8 @@ PP(pp_rv2av)
 {
     dSP; dTOPss;
     const I32 gimme = GIMME_V;
+    static const char an_array[] = "an ARRAY";
+    static const char a_hash[] = "a HASH";
     const bool is_pp_rv2av = PL_op->op_type == OP_RV2AV
                          || PL_op->op_type == OP_LVAVREF;
     const svtype type = is_pp_rv2av ? SVt_PVAV : SVt_PVHV;
@@ -903,7 +905,7 @@ PP(pp_rv2av)
        sv = SvRV(sv);
        if (UNLIKELY(SvTYPE(sv) != type))
            /* diag_listed_as: Not an ARRAY reference */
-           DIE(aTHX_ "Not %s reference", is_pp_rv2av ? "an ARRAY" : "a HASH");
+           DIE(aTHX_ "Not %s reference", is_pp_rv2av ? an_array : a_hash);
        else if (UNLIKELY(PL_op->op_flags & OPf_MOD
                && PL_op->op_private & OPpLVAL_INTRO))
            Perl_croak(aTHX_ "%s", PL_no_localize_ref);
@@ -912,7 +914,7 @@ PP(pp_rv2av)
            GV *gv;
        
            if (!isGV_with_GP(sv)) {
-               gv = Perl_softref2xv(aTHX_ sv, is_pp_rv2av ? "an ARRAY" : "a HASH",
+               gv = Perl_softref2xv(aTHX_ sv, is_pp_rv2av ? an_array : a_hash,
                                     type, &sp);
                if (!gv)
                    RETURN;

diff --git a/proto.h b/proto.h
index 0728c45..a0c4a40 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1392,11 +1392,7 @@ PERL_CALLCONV UV Perl_grok_oct(pTHX_ const char* start, STRLEN* len_p, I32* flag
 /* PERL_CALLCONV GV*   Perl_gv_AVadd(pTHX_ GV *gv); */
 /* PERL_CALLCONV GV*   Perl_gv_HVadd(pTHX_ GV *gv); */
 /* PERL_CALLCONV GV*   Perl_gv_IOadd(pTHX_ GV* gv); */
-PERL_CALLCONV SV*      Perl_gv_add_by_type_p(pTHX_ GV *gv, gv_add_type type)
-                       __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_GV_ADD_BY_TYPE_P      \
-       assert(gv)
-
+PERL_CALLCONV GV*      Perl_gv_add_by_type(pTHX_ GV *gv, svtype type);
 /* PERL_CALLCONV GV*   gv_autoload4(pTHX_ HV* stash, const char* name, STRLEN len, I32 method)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_2); */

diff --git a/scope.c b/scope.c
index e1d26fb..89b4e6e 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -216,17 +216,17 @@ Perl_save_pushptrptr(pTHX_ void *const ptr1, void *const ptr2, const int type)
 SV *
 Perl_save_scalar(pTHX_ GV *gv)
 {
-    SV * const sv = GvSVn(gv);
+    SV ** const sptr = &GvSVn(gv);
 
     PERL_ARGS_ASSERT_SAVE_SCALAR;
 
-    if (UNLIKELY(SvGMAGICAL(sv))) {
+    if (UNLIKELY(SvGMAGICAL(*sptr))) {
         PL_localizing = 1;
-        (void)mg_get(sv);
+        (void)mg_get(*sptr);
         PL_localizing = 0;
     }
-    save_pushptrptr(SvREFCNT_inc_simple(gv), SvREFCNT_inc(sv), SAVEt_SV);
-    return save_scalar_at(&GvSV(gv), SAVEf_SETMAGIC); /* XXX - FIXME - see #60360 */
+    save_pushptrptr(SvREFCNT_inc_simple(gv), SvREFCNT_inc(*sptr), SAVEt_SV);
+    return save_scalar_at(sptr, SAVEf_SETMAGIC); /* XXX - FIXME - see #60360 */
 }
 
 /* Like save_sptr(), but also SvREFCNT_dec()s the new value.  Can be used to