varsv = GvSVn(vargv);
sv_setpvn(varsv, packname, packname_len);
sv_catpvs(varsv, "::");
- sv_catpvn(varsv, name, len);
+ /* Ensure SvSETMAGIC() is called if necessary. In particular, to clear
+ tainting if $FOO::AUTOLOAD was previously tainted, but is not now. */
+ sv_catpvn_mg(varsv, name, len);
return gv;
}
if (!tmpgv)
return NULL;
stash = GvHV(tmpgv);
+ if (!(flags & ~GV_NOADD_MASK) && !stash) return NULL;
assert(stash);
- assert(HvNAME_get(stash));
+ if (!HvNAME_get(stash)) {
+ hv_name_set(stash, name, namelen, 0);
+
+ /* FIXME: This is a repeat of logic in gv_fetchpvn_flags */
+ /* If the containing stash has multiple effective
+ names, see that this one gets them, too. */
+ if (HvAUX(GvSTASH(tmpgv))->xhv_name_count)
+ mro_package_moved(stash, NULL, tmpgv, 1);
+ }
return stash;
}
}
for (name_cursor = name; name_cursor < name_end; name_cursor++) {
- if ((*name_cursor == ':' && name_cursor < name_em1
+ if (name_cursor < name_em1 &&
+ ((*name_cursor == ':'
&& name_cursor[1] == ':')
- || (*name_cursor == '\'' && name_cursor[1]))
+ || *name_cursor == '\''))
{
if (!stash)
stash = PL_defstash;
return NULL;
len = name_cursor - name;
- if (len > 0) {
+ if (name_cursor > nambeg) { /* Skip for initial :: or ' */
const char *key;
if (*name_cursor == ':') {
key = name;
GvMULTI_on(gv);
}
if (key != name)
- Safefree((char *)key);
+ Safefree(key);
if (!gv || gv == (const GV *)&PL_sv_undef)
return NULL;
if (*name_cursor == ':')
name_cursor++;
- name_cursor++;
- name = name_cursor;
+ name = name_cursor+1;
if (name == name_end)
return gv
? gv : MUTABLE_GV(*hv_fetchs(PL_defstash, "main::", TRUE));
if (add) {
GvMULTI_on(gv);
gv_init_sv(gv, sv_type);
- if (len == 1 && (sv_type == SVt_PVHV || sv_type == SVt_PVGV)) {
+ if (len == 1 && stash == PL_defstash
+ && (sv_type == SVt_PVHV || sv_type == SVt_PVGV)) {
if (*name == '!')
require_tie_mod(gv, "!", newSVpvs("Errno"), "TIEHASH", 1);
else if (*name == '-' || *name == '+')
if (stash != PL_defstash) { /* not the main stash */
/* We only have to check for four names here: EXPORT, ISA, OVERLOAD
and VERSION. All the others apply only to the main stash. */
- if (len > 1) {
+ if (len > 2) {
const char * const name2 = name + 1;
switch (*name) {
case 'E':
case '>': /* $> */
case '\\': /* $\ */
case '/': /* $/ */
+ case '$': /* $$ */
case '\001': /* $^A */
case '\003': /* $^C */
case '\004': /* $^D */
{
dVAR;
GP* gp;
+ int attempts = 100;
if (!gv || !isGV_with_GP(gv) || !(gp = GvGP(gv)))
return;
return;
}
- if (gp->gp_file_hek)
- unshare_hek(gp->gp_file_hek);
- SvREFCNT_dec(gp->gp_sv);
- SvREFCNT_dec(gp->gp_av);
- /* FIXME - another reference loop GV -> symtab -> GV ?
- Somehow gp->gp_hv can end up pointing at freed garbage. */
- if (gp->gp_hv && SvTYPE(gp->gp_hv) == SVt_PVHV) {
- const char *hvname = HvNAME_get(gp->gp_hv);
+ while (1) {
+ /* Copy and null out all the glob slots, so destructors do not see
+ freed SVs. */
+ HEK * const file_hek = gp->gp_file_hek;
+ SV * const sv = gp->gp_sv;
+ AV * const av = gp->gp_av;
+ HV * const hv = gp->gp_hv;
+ IO * const io = gp->gp_io;
+ CV * const cv = gp->gp_cv;
+ CV * const form = gp->gp_form;
+
+ gp->gp_file_hek = NULL;
+ gp->gp_sv = NULL;
+ gp->gp_av = NULL;
+ gp->gp_hv = NULL;
+ gp->gp_io = NULL;
+ gp->gp_cv = NULL;
+ gp->gp_form = NULL;
+
+ if (file_hek)
+ unshare_hek(file_hek);
+
+ SvREFCNT_dec(sv);
+ SvREFCNT_dec(av);
+ /* FIXME - another reference loop GV -> symtab -> GV ?
+ Somehow gp->gp_hv can end up pointing at freed garbage. */
+ if (hv && SvTYPE(hv) == SVt_PVHV) {
+ const char *hvname = HvNAME_get(hv);
if (PL_stashcache && hvname)
- (void)hv_delete(PL_stashcache, hvname, HvNAMELEN_get(gp->gp_hv),
+ (void)hv_delete(PL_stashcache, hvname, HvNAMELEN_get(hv),
G_DISCARD);
- SvREFCNT_dec(gp->gp_hv);
+ SvREFCNT_dec(hv);
+ }
+ SvREFCNT_dec(io);
+ SvREFCNT_dec(cv);
+ SvREFCNT_dec(form);
+
+ if (!gp->gp_file_hek
+ && !gp->gp_sv
+ && !gp->gp_av
+ && !gp->gp_hv
+ && !gp->gp_io
+ && !gp->gp_cv
+ && !gp->gp_form) break;
+
+ if (--attempts == 0) {
+ Perl_die(aTHX_
+ "panic: gp_free failed to free glob pointer - "
+ "something is repeatedly re-creating entries"
+ );
+ }
}
- SvREFCNT_dec(gp->gp_io);
- SvREFCNT_dec(gp->gp_cv);
- SvREFCNT_dec(gp->gp_form);
Safefree(gp);
GvGP_set(gv, NULL);
return TRUE;
}
}
+ if(left==right && SvGMAGICAL(left)) {
+ SV * const left = sv_newmortal();
+ *(sp-1) = left;
+ /* Print the uninitialized warning now, so it includes the vari-
+ able name. */
+ if (!SvOK(right)) {
+ if (ckWARN(WARN_UNINITIALIZED)) report_uninit(right);
+ sv_setsv_flags(left, &PL_sv_no, 0);
+ }
+ else sv_setsv_flags(left, right, 0);
+ SvGETMAGIC(right);
+ }
if (flags & AMGf_numeric) {
- if (SvROK(left))
- *(sp-1) = sv_2num(left);
+ if (SvROK(TOPm1s))
+ *(sp-1) = sv_2num(TOPm1s);
if (SvROK(right))
*sp = sv_2num(right);
}