/* gv.c
*
- * Copyright (c) 1991-2000, Larry Wall
+ * Copyright (c) 1991-2001, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
{
if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
Perl_croak(aTHX_ "Bad symbol for filehandle");
- if (!GvIOp(gv))
+ if (!GvIOp(gv)) {
+#ifdef GV_SHARED_CHECK
+ if (GvSHARED(gv)) {
+ Perl_croak(aTHX_ "Bad symbol for filehandle (GV is shared)");
+ }
+#endif
GvIOp(gv) = newIO();
+ }
return gv;
}
return Nullgv;
cv = GvCV(gv);
- if (!CvROOT(cv))
+ if (!(CvROOT(cv) || CvXSUB(cv)))
return Nullgv;
/*
"Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
HvNAME(stash), (int)len, name);
+#ifndef USE_THREADS
+ if (CvXSUB(cv)) {
+ /* rather than lookup/init $AUTOLOAD here
+ * only to have the XSUB do another lookup for $AUTOLOAD
+ * and split that value on the last '::',
+ * pass along the same data via some unused fields in the CV
+ */
+ CvSTASH(cv) = stash;
+ SvPVX(cv) = (char *)name; /* cast to loose constness warning */
+ SvCUR(cv) = len;
+ return gv;
+ }
+#endif
+
/*
* Given &FOO::AUTOLOAD, set $FOO::AUTOLOAD to desired function name.
* The subroutine's original name may not be "AUTOLOAD", so we don't
HV *hv;
I32 i;
if (!PL_psig_ptr) {
- int sig_num[] = { SIG_NUM };
- New(73, PL_psig_ptr, sizeof(sig_num)/sizeof(*sig_num), SV*);
- New(73, PL_psig_name, sizeof(sig_num)/sizeof(*sig_num), SV*);
+ Newz(73, PL_psig_ptr, SIG_SIZE, SV*);
+ Newz(73, PL_psig_name, SIG_SIZE, SV*);
+ Newz(73, PL_psig_pend, SIG_SIZE, int);
}
GvMULTI_on(gv);
hv = GvHVn(gv);
hv_magic(hv, Nullgv, 'S');
- for (i = 1; PL_sig_name[i]; i++) {
+ for (i = 1; i < SIG_SIZE; i++) {
SV ** init;
init = hv_fetch(hv, PL_sig_name[i], strlen(PL_sig_name[i]), 1);
if (init)
sv_setsv(*init, &PL_sv_undef);
PL_psig_ptr[i] = 0;
PL_psig_name[i] = 0;
+ PL_psig_pend[i] = 0;
}
}
break;
}
#endif /* Microport 2.4 hack */
+int
+Perl_magic_freeovrld(pTHX_ SV *sv, MAGIC *mg)
+{
+ AMT *amtp = (AMT*)mg->mg_ptr;
+ if (amtp && AMT_AMAGIC(amtp)) {
+ int i;
+ for (i = 1; i < NofAMmeth; i++) {
+ CV *cv = amtp->table[i];
+ if (cv != Nullcv) {
+ SvREFCNT_dec((SV *) cv);
+ amtp->table[i] = Nullcv;
+ }
+ }
+ }
+ return 0;
+}
+
/* Updates and caches the CV's */
bool
if (mg && amtp->was_ok_am == PL_amagic_generation
&& amtp->was_ok_sub == PL_sub_generation)
- return AMT_AMAGIC(amtp);
- if (amtp && AMT_AMAGIC(amtp)) { /* Have table. */
- int i;
- for (i=1; i<NofAMmeth; i++) {
- if (amtp->table[i]) {
- SvREFCNT_dec(amtp->table[i]);
- }
- }
- }
+ return AMT_OVERLOADED(amtp);
sv_unmagic((SV*)stash, 'c');
DEBUG_o( Perl_deb(aTHX_ "Recalcing overload magic in package %s\n",HvNAME(stash)) );
+ Zero(&amt,1,AMT);
amt.was_ok_am = PL_amagic_generation;
amt.was_ok_sub = PL_sub_generation;
amt.fallback = AMGfallNO;
amt.flags = 0;
{
- int filled = 0;
- int i;
+ int filled = 0, have_ovl = 0;
+ int i, lim = 1;
const char *cp;
SV* sv = NULL;
sv = GvSV(gv);
if (!gv)
- goto no_table;
+ lim = DESTROY_amg; /* Skip overloading entries. */
else if (SvTRUE(sv))
amt.fallback=AMGfallYES;
else if (SvOK(sv))
amt.fallback=AMGfallNEVER;
- for (i = 1; i < NofAMmeth; i++) {
- char *cooky = PL_AMG_names[i];
- char *cp = AMG_id2name(i); /* Human-readable form, for debugging */
+ for (i = 1; i < lim; i++)
+ amt.table[i] = Nullcv;
+ for (; i < NofAMmeth; i++) {
+ char *cooky = (char*)PL_AMG_names[i];
+ /* Human-readable form, for debugging: */
+ char *cp = (i >= DESTROY_amg ? cooky : AMG_id2name(i));
STRLEN l = strlen(cooky);
DEBUG_o( Perl_deb(aTHX_ "Checking overloading of `%s' in package `%.256s'\n",
cp, HvNAME(stash), HvNAME(GvSTASH(CvGV(cv))),
GvNAME(CvGV(cv))) );
filled = 1;
+ if (i < DESTROY_amg)
+ have_ovl = 1;
}
amt.table[i]=(CV*)SvREFCNT_inc(cv);
}
if (filled) {
AMT_AMAGIC_on(&amt);
+ if (have_ovl)
+ AMT_OVERLOADED_on(&amt);
sv_magic((SV*)stash, 0, 'c', (char*)&amt, sizeof(AMT));
- return TRUE;
+ return have_ovl;
}
}
/* Here we have no table: */
return FALSE;
}
+
+CV*
+Perl_gv_handler(pTHX_ HV *stash, I32 id)
+{
+ dTHR;
+ MAGIC *mg;
+ AMT *amtp;
+
+ if (!stash)
+ return Nullcv;
+ mg = mg_find((SV*)stash,'c');
+ if (!mg) {
+ do_update:
+ Gv_AMupdate(stash);
+ mg = mg_find((SV*)stash,'c');
+ }
+ amtp = (AMT*)mg->mg_ptr;
+ if ( amtp->was_ok_am != PL_amagic_generation
+ || amtp->was_ok_sub != PL_sub_generation )
+ goto do_update;
+ if (AMT_AMAGIC(amtp))
+ return amtp->table[id];
+ return Nullcv;
+}
+
+
SV*
Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
{
lr = 1;
}
break;
+ case int_amg:
case iter_amg: /* XXXX Eventually should do to_gv. */
/* FAIL safe */
return NULL; /* Delegate operation to standard mechanisms. */