our($VERSION, @ISA, @EXPORT_OK);
-$VERSION = "1.20";
+$VERSION = "1.21";
use Carp;
use Exporter ();
/* the assignment to global defstash changes our sense of 'main' */
PL_defstash = gv_stashsv(Package, GV_ADDWARN); /* should exist already */
- save_hptr(&PL_curstash);
- PL_curstash = PL_defstash;
+ SAVEGENERICSV(PL_curstash);
+ PL_curstash = (HV *)SvREFCNT_inc_simple(PL_defstash);
/* defstash must itself contain a main:: so we'll add that now */
/* take care with the ref counts (was cause of long standing bug) */
PERL_ARGS_ASSERT_PACKAGE;
- save_hptr(&PL_curstash);
+ SAVEGENERICSV(PL_curstash);
save_item(PL_curstname);
- PL_curstash = gv_stashsv(sv, GV_ADD);
+ PL_curstash = (HV *)SvREFCNT_inc(gv_stashsv(sv, GV_ADD));
sv_setsv(PL_curstname, sv);
}
}
if (const_sv) {
+ HV *stash;
SvREFCNT_inc_simple_void_NN(const_sv);
if (cv) {
assert(!CvROOT(cv) && !CvCONST(cv));
GvCV_set(gv, NULL);
cv = newCONSTSUB_flags(NULL, name, name_is_utf8 ? SVf_UTF8 : 0, const_sv);
}
- mro_method_changed_in( /* sub Foo::Bar () { 123 } */
+ stash =
(CvGV(cv) && GvSTASH(CvGV(cv)))
? GvSTASH(CvGV(cv))
: CvSTASH(cv)
? CvSTASH(cv)
- : PL_curstash
- );
+ : PL_curstash;
+ if (HvENAME_HEK(stash))
+ mro_method_changed_in(stash); /* sub Foo::Bar () { 123 } */
if (PL_madskills)
goto install_block;
op_free(block);
}
}
GvCVGEN(gv) = 0;
- mro_method_changed_in(GvSTASH(gv)); /* sub Foo::bar { (shift)+1 } */
+ if (HvENAME_HEK(GvSTASH(gv)))
+ /* sub Foo::bar { (shift)+1 } */
+ mro_method_changed_in(GvSTASH(gv));
}
}
if (!CvGV(cv)) {
PL_hints &= ~HINT_BLOCK_SCOPE;
if (stash) {
- SAVESPTR(PL_curstash);
+ SAVEGENERICSV(PL_curstash);
SAVECOPSTASH(PL_curcop);
- PL_curstash = stash;
+ PL_curstash = (HV *)SvREFCNT_inc_simple_NN(stash);
CopSTASH_set(PL_curcop,stash);
}
if (name) {
GvCV_set(gv,cv);
GvCVGEN(gv) = 0;
- mro_method_changed_in(GvSTASH(gv)); /* newXS */
+ if (HvENAME_HEK(GvSTASH(gv)))
+ mro_method_changed_in(GvSTASH(gv)); /* newXS */
}
}
if (!name)
=cut
*/
+#define SET_CURSTASH(newstash) \
+ if (PL_curstash != newstash) { \
+ SvREFCNT_dec(PL_curstash); \
+ PL_curstash = (HV *)SvREFCNT_inc(newstash); \
+ }
+
int
perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
{
while (PL_scopestack_ix > oldscope)
LEAVE;
FREETMPS;
- PL_curstash = PL_defstash;
+ SET_CURSTASH(PL_defstash);
if (PL_unitcheckav) {
call_list(oldscope, PL_unitcheckav);
}
}
}
CopLINE_set(PL_curcop, 0);
- PL_curstash = PL_defstash;
+ SET_CURSTASH(PL_defstash);
if (PL_e_script) {
SvREFCNT_dec(PL_e_script);
PL_e_script = NULL;
while (PL_scopestack_ix > oldscope)
LEAVE;
FREETMPS;
- PL_curstash = PL_defstash;
+ SET_CURSTASH(PL_defstash);
if (!(PL_exit_flags & PERL_EXIT_DESTRUCT_END) &&
PL_endav && !PL_minus_c) {
PERL_SET_PHASE(PERL_PHASE_END);
/* FALL THROUGH */
case 2:
/* my_exit() was called */
- PL_curstash = PL_defstash;
+ SET_CURSTASH(PL_defstash);
FREETMPS;
JMPENV_POP;
my_exit_jump();
/* FALL THROUGH */
case 2:
/* my_exit() was called */
- PL_curstash = PL_defstash;
+ SET_CURSTASH(PL_defstash);
FREETMPS;
JMPENV_POP;
my_exit_jump();
dVAR;
GV *gv;
- PL_curstash = PL_defstash = newHV();
+ PL_curstash = PL_defstash = (HV *)SvREFCNT_inc_simple_NN(newHV());
/* We know that the string "main" will be in the global shared string
table, so it's a small saving to use it rather than allocate another
8 bytes. */
#endif
sv_grow(ERRSV, 240); /* Preallocate - for immediate signals. */
CLEAR_ERRSV();
- PL_curstash = PL_defstash;
+ SET_CURSTASH(PL_defstash);
CopSTASH_set(&PL_compiling, PL_defstash);
PL_debstash = GvHV(gv_fetchpvs("DB::", GV_ADDMULTI, SVt_PVHV));
PL_globalstash = GvHV(gv_fetchpvs("CORE::GLOBAL::", GV_ADDMULTI,
dVAR;
HV * const ostash = PL_curstash;
- PL_curstash = PL_debstash;
+ PL_curstash = (HV *)SvREFCNT_inc_simple(PL_debstash);
Perl_init_dbargs(aTHX);
PL_DBgv = gv_fetchpvs("DB::DB", GV_ADDMULTI, SVt_PVGV);
PL_DBsignal = GvSV((gv_fetchpvs("DB::signal", GV_ADDMULTI, SVt_PV)));
if (!SvIOK(PL_DBsignal))
sv_setiv(PL_DBsignal, 0);
+ SvREFCNT_dec(PL_curstash);
PL_curstash = ostash;
}
while (PL_scopestack_ix > oldscope)
LEAVE;
FREETMPS;
- PL_curstash = PL_defstash;
+ SET_CURSTASH(PL_defstash);
PL_curcop = &PL_compiling;
CopLINE_set(PL_curcop, oldline);
JMPENV_POP;
/* make sure we compile in the right package */
if (CopSTASH_ne(PL_curcop, PL_curstash)) {
- SAVESPTR(PL_curstash);
- PL_curstash = CopSTASH(PL_curcop);
+ SAVEGENERICSV(PL_curstash);
+ PL_curstash = (HV *)SvREFCNT_inc_simple(CopSTASH(PL_curcop));
}
/* XXX:ajgo do we really need to alloc an AV for begin/checkunit */
SAVESPTR(PL_beginav);
/* symbol tables */
PL_defstash = hv_dup_inc(proto_perl->Idefstash, param);
- PL_curstash = hv_dup(proto_perl->Icurstash, param);
+ PL_curstash = hv_dup_inc(proto_perl->Icurstash, param);
PL_debstash = hv_dup(proto_perl->Idebstash, param);
PL_globalstash = hv_dup(proto_perl->Iglobalstash, param);
PL_curstname = sv_dup_inc(proto_perl->Icurstname, param);
BEGIN { require "./test.pl"; }
-plan( tests => 56 );
+plan( tests => 57 );
# Used to segfault (bug #15479)
fresh_perl_like(
# [perl #88138] ' not equivalent to :: before a null
${"a'\0b"} = "c";
is ${"a::\0b"}, "c", "' is equivalent to :: before a null";
+
+# [perl #101486] Clobbering the current package
+ok eval '
+ package Do;
+ BEGIN { *Do:: = *Re:: }
+ sub foo{};
+ 1
+ ', 'no crashing or errors when clobbering the current package';
LEAVE;
FREETMPS;
PL_curstash = PL_defstash;
+ if (PL_curstash != PL_defstash) {
+ SvREFCNT_dec(PL_curstash);
+ PL_curstash = (HV *)SvREFCNT_inc(PL_defstash);
+ }
if (PL_endav && !PL_minus_c)
call_list(oldscope, PL_endav);
status = STATUS_EXIT;