/* 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;
}
LEAVE;
PL_sub_generation++;
- CvGV(GvCV(gv)) = (GV*)SvREFCNT_inc(gv);
+ CvGV(GvCV(gv)) = gv;
CvFILE(GvCV(gv)) = CopFILE(PL_curcop);
CvSTASH(GvCV(gv)) = PL_curstash;
#ifdef USE_THREADS
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
return gv;
}
+/* The "gv" parameter should be the glob known to Perl code as *!
+ * The scalar must already have been magicalized.
+ */
+STATIC void
+S_require_errno(pTHX_ GV *gv)
+{
+ HV* stash = gv_stashpvn("Errno",5,FALSE);
+
+ if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) {
+ dSP;
+ PUTBACK;
+ ENTER;
+ save_scalar(gv); /* keep the value of $! */
+ require_pv("Errno.pm");
+ LEAVE;
+ SPAGAIN;
+ stash = gv_stashpvn("Errno",5,FALSE);
+ if (!stash || !(gv_fetchmethod(stash, "TIEHASH")))
+ Perl_croak(aTHX_ "Can't use %%! because Errno.pm is not available");
+ }
+}
+
/*
=for apidoc gv_stashpv
if (add) {
GvMULTI_on(gv);
gv_init_sv(gv, sv_type);
+ if (*name=='!' && sv_type == SVt_PVHV && len==1)
+ require_errno(gv);
}
return gv;
} else if (add & GV_NOINIT) {
gv_init(gv, stash, name, len, add & GV_ADDMULTI);
gv_init_sv(gv, sv_type);
- if (isLEXWARN_on && isALPHA(name[0]) && ! ckWARN(WARN_ONCE))
+ if (isALPHA(name[0]) && ! (isLEXWARN_on ? ckWARN(WARN_ONCE)
+ : (PL_dowarn & G_WARN_ON ) ) )
GvMULTI_on(gv) ;
/* set up magic where warranted */
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;
case '!':
if (len > 1)
break;
- if (sv_type > SVt_PV && PL_curcop != &PL_compiling) {
- HV* stash = gv_stashpvn("Errno",5,FALSE);
- if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) {
- dSP;
- PUTBACK;
- require_pv("Errno.pm");
- SPAGAIN;
- stash = gv_stashpvn("Errno",5,FALSE);
- if (!stash || !(gv_fetchmethod(stash, "TIEHASH")))
- Perl_croak(aTHX_ "Can't use %%! because Errno.pm is not available");
- }
- }
- goto magicalize;
+
+ /* If %! has been used, automatically load Errno.pm.
+ The require will itself set errno, so in order to
+ preserve its value we have to set up the magic
+ now (rather than going to magicalize)
+ */
+
+ sv_magic(GvSV(gv), (SV*)gv, 0, name, len);
+
+ if (sv_type == SVt_PVHV)
+ require_errno(gv);
+
+ break;
case '-':
if (len > 1)
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_OVERLOADED(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]);
- }
- }
- }
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;
{
int filled = 0, have_ovl = 0;
int i, lim = 1;
- const char *cp;
SV* sv = NULL;
/* Work with "fallback" key, which we assume to be first in PL_AMG_names */
}
}
/* Here we have no table: */
- no_table:
+ /* no_table: */
AMT_AMAGIC_off(&amt);
sv_magic((SV*)stash, 0, 'c', (char*)&amt, sizeof(AMTS));
return FALSE;
lr = 1;
}
break;
+ case int_amg:
case iter_amg: /* XXXX Eventually should do to_gv. */
/* FAIL safe */
return NULL; /* Delegate operation to standard mechanisms. */
projects / p5sagit/p5-mst-13.2.git / blobdiff