Change 29971 by [EMAIL PROTECTED] on 2007/01/25 11:59:28
Integrate:
[ 28058]
De-duplicate the code that creates new GPs into Perl_newGP().
[back out the gv.c part of:]
[ 29735]
We can get in the messy situation of the COP that PL_curcop pointed
to getting freed, and as part of the same free overloading decides
to look for DESTROY, which needs to *create* a GV, which in turn
was expecting that PL_curcop pointed to something valid. So set
PL_curcop to NULL if we're freeing the COP that it points to, and
make Perl_gv_init() cope with a NULL PL_curcop.
[ 29748]
An implementation of change 29735 for blead (PL_curcop could be NULL)
given that blead's refactoring is not yet in maint.
[ 29970]
Change 28058 hadn't been tested with -DPERL_CREATE_GVSV
Affected files ...
... //depot/maint-5.8/perl/embed.fnc#188 integrate
... //depot/maint-5.8/perl/embed.h#141 integrate
... //depot/maint-5.8/perl/gv.c#91 edit
... //depot/maint-5.8/perl/proto.h#177 integrate
... //depot/maint-5.8/perl/scope.c#62 integrate
Differences ...
==== //depot/maint-5.8/perl/embed.fnc#188 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#187~29968~ 2007-01-25 02:55:13.000000000 -0800
+++ perl/embed.fnc 2007-01-25 03:59:28.000000000 -0800
@@ -295,6 +295,7 @@
Ap |void |gv_fullname |NN SV* sv|NN GV* gv
Apmb |void |gv_fullname3 |NN SV* sv|NN GV* gv|NULLOK const char* prefix
Ap |void |gv_fullname4 |NN SV* sv|NN GV* gv|NULLOK const char*
prefix|bool keepmain
+pMox |GP * |newGP |NN GV *const gv
Ap |void |gv_init |NN GV* gv|NULLOK HV* stash|NN const char*
name|STRLEN len|int multi
Ap |void |gv_name_set |NN GV* gv|NULLOK const char *name|U32 len|U32
flags
Apd |HV* |gv_stashpv |NN const char* name|I32 create
==== //depot/maint-5.8/perl/embed.h#141 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#140~29968~ 2007-01-25 02:55:13.000000000 -0800
+++ perl/embed.h 2007-01-25 03:59:28.000000000 -0800
@@ -2372,6 +2372,8 @@
#define gv_fetchpv(a,b,c) Perl_gv_fetchpv(aTHX_ a,b,c)
#define gv_fullname(a,b) Perl_gv_fullname(aTHX_ a,b)
#define gv_fullname4(a,b,c,d) Perl_gv_fullname4(aTHX_ a,b,c,d)
+#ifdef PERL_CORE
+#endif
#define gv_init(a,b,c,d,e) Perl_gv_init(aTHX_ a,b,c,d,e)
#define gv_name_set(a,b,c,d) Perl_gv_name_set(aTHX_ a,b,c,d)
#define gv_stashpv(a,b) Perl_gv_stashpv(aTHX_ a,b)
==== //depot/maint-5.8/perl/gv.c#91 (text) ====
Index: perl/gv.c
--- perl/gv.c#90~29964~ 2007-01-24 15:53:28.000000000 -0800
+++ perl/gv.c 2007-01-25 03:59:28.000000000 -0800
@@ -154,10 +154,31 @@
return SvROK(gv) ? SvRV(gv) : NULL;
}
+GP *
+Perl_newGP(pTHX_ GV *const gv)
+{
+ GP *gp;
+ const char *const file
+ = (PL_curcop && CopFILE(PL_curcop)) ? CopFILE(PL_curcop) : "";
+ Newxz(gp, 1, GP);
+
+#ifndef PERL_DONT_CREATE_GVSV
+ gp->gp_sv = newSV(0);
+#endif
+
+ gp->gp_line = PL_curcop ? CopLINE(PL_curcop) : 0;
+ /* XXX Ideally this cast would be replaced with a change to const char*
+ in the struct. */
+ gp->gp_file = (char *) file;
+ gp->gp_egv = gv;
+ gp->gp_refcnt = 1;
+
+ return gp;
+}
+
void
Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
{
- register GP *gp;
const bool doproto = SvTYPE(gv) > SVt_NULL;
const char * const proto = (doproto && SvPOK(gv)) ? SvPVX_const(gv) : NULL;
SV *const has_constant = doproto && SvROK(gv) ? SvRV(gv) : NULL;
@@ -188,28 +209,8 @@
} else
Safefree(SvPVX_mutable(gv));
}
- Newxz(gp, 1, GP);
- GvGP(gv) = gp_ref(gp);
-#ifdef PERL_DONT_CREATE_GVSV
- GvSV(gv) = NULL;
-#else
- GvSV(gv) = newSV(0);
-#endif
- if (PL_curcop) {
- /* We can get in the messy situation of the COP that PL_curcop pointed
- to getting freed, and as part of the same free overloading decides
- to look for DESTROY, which gets us in here, needing to *create* a
- GV. */
- GvLINE(gv) = CopLINE(PL_curcop);
- /* XXX Ideally this cast would be replaced with a change to const char*
- in the struct. */
- GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : (char *) "";
- } else {
- GvLINE(gv) = 0;
- GvFILE(gv) = (char *) "";
- }
- GvCVGEN(gv) = 0;
- GvEGV(gv) = gv;
+
+ GvGP(gv) = Perl_newGP(aTHX_ gv);
sv_magic((SV*)gv, (SV*)gv, PERL_MAGIC_glob, NULL, 0);
GvSTASH(gv) = (HV*)SvREFCNT_inc(stash);
gv_name_set(gv, name, len, GV_ADD);
==== //depot/maint-5.8/perl/proto.h#177 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#176~29968~ 2007-01-25 02:55:13.000000000 -0800
+++ perl/proto.h 2007-01-25 03:59:28.000000000 -0800
@@ -372,6 +372,7 @@
PERL_CALLCONV void Perl_gv_fullname(pTHX_ SV* sv, GV* gv);
/* PERL_CALLCONV void Perl_gv_fullname3(pTHX_ SV* sv, GV* gv, const char*
prefix); */
PERL_CALLCONV void Perl_gv_fullname4(pTHX_ SV* sv, GV* gv, const char*
prefix, bool keepmain);
+PERL_CALLCONV GP * Perl_newGP(pTHX_ GV *const gv);
PERL_CALLCONV void Perl_gv_init(pTHX_ GV* gv, HV* stash, const char* name,
STRLEN len, int multi);
PERL_CALLCONV void Perl_gv_name_set(pTHX_ GV* gv, const char *name, U32
len, U32 flags);
PERL_CALLCONV HV* Perl_gv_stashpv(pTHX_ const char* name, I32 create);
==== //depot/maint-5.8/perl/scope.c#62 (text) ====
Index: perl/scope.c
--- perl/scope.c#61~29961~ 2007-01-24 14:12:24.000000000 -0800
+++ perl/scope.c 2007-01-25 03:59:28.000000000 -0800
@@ -274,9 +274,7 @@
SSPUSHINT(SAVEt_GP_NEW);
if (empty) {
- register GP *gp;
-
- Newxz(gp, 1, GP);
+ GP *gp = Perl_newGP(aTHX_ gv);
if (GvCVu(gv))
PL_sub_generation++; /* taking a method out of circulation */
@@ -284,15 +282,7 @@
gp->gp_io = newIO();
IoFLAGS(gp->gp_io) |= IOf_ARGV|IOf_START;
}
- GvGP(gv) = gp_ref(gp);
-#ifndef PERL_DONT_CREATE_GVSV
- GvSV(gv) = newSV(0);
-#endif
- GvLINE(gv) = CopLINE(PL_curcop);
- /* XXX Ideally this cast would be replaced with a change to const char*
- in the struct. */
- GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : (char *) "";
- GvEGV(gv) = gv;
+ GvGP(gv) = gp;
}
else {
gp_ref(GvGP(gv));
End of Patch.
