/* gv.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* 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 scalar");
if (!GvSV(gv))
- GvSV(gv) = NEWSV(72,0);
+ GvSV(gv) = newSV(0);
return gv;
}
#endif
GV *
Perl_gv_IOadd(pTHX_ register GV *gv)
{
+ dVAR;
if (!gv || SvTYPE((SV*)gv) != SVt_PVGV) {
/*
GV *
Perl_gv_fetchfile(pTHX_ const char *name)
{
+ dVAR;
char smallbuf[256];
char *tmpbuf;
STRLEN tmplen;
#ifdef PERL_DONT_CREATE_GVSV
GvSV(gv) = NULL;
#else
- GvSV(gv) = NEWSV(72,0);
+ GvSV(gv) = newSV(0);
#endif
GvLINE(gv) = CopLINE(PL_curcop);
/* XXX Ideally this cast would be replaced with a change to const char*
GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : (char *) "";
GvCVGEN(gv) = 0;
GvEGV(gv) = gv;
- sv_magic((SV*)gv, (SV*)gv, PERL_MAGIC_glob, Nullch, 0);
+ sv_magic((SV*)gv, (SV*)gv, PERL_MAGIC_glob, NULL, 0);
GvSTASH(gv) = stash;
if (stash)
Perl_sv_add_backref(aTHX_ (SV*)stash, (SV*)gv);
case SVt_NULL:
case SVt_PVCV:
case SVt_PVFM:
+ case SVt_PVGV:
break;
default:
(void)GvSVn(gv);
GV *
Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
{
+ dVAR;
AV* av;
GV* topgv;
GV* gv;
/* UNIVERSAL methods should be callable without a stash */
if (!stash) {
level = -1; /* probably appropriate */
- if(!(stash = gv_stashpvn(STR_WITH_LEN("UNIVERSAL"), FALSE)))
+ if(!(stash = gv_stashpvs("UNIVERSAL", FALSE)))
return 0;
}
return topgv;
/* Stale cached entry: junk it */
SvREFCNT_dec(cv);
- GvCV(topgv) = cv = Nullcv;
+ GvCV(topgv) = cv = NULL;
GvCVGEN(topgv) = 0;
}
else if (GvCVGEN(topgv) == PL_sub_generation)
return 0; /* cache indicates sub doesn't exist */
}
- gvp = (GV**)hv_fetch(stash, "ISA", 3, FALSE);
+ gvp = (GV**)hv_fetchs(stash, "ISA", FALSE);
av = (gvp && (gv = *gvp) && gv != (GV*)&PL_sv_undef) ? GvAV(gv) : NULL;
/* create and re-create @.*::SUPER::ISA on demand */
packlen -= 7;
basestash = gv_stashpvn(hvname, packlen, TRUE);
- gvp = (GV**)hv_fetch(basestash, "ISA", 3, FALSE);
+ gvp = (GV**)hv_fetchs(basestash, "ISA", FALSE);
if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) {
- gvp = (GV**)hv_fetch(stash, "ISA", 3, TRUE);
+ gvp = (GV**)hv_fetchs(stash, "ISA", TRUE);
if (!gvp || !(gv = *gvp))
Perl_croak(aTHX_ "Cannot create %s::ISA", hvname);
if (SvTYPE(gv) != SVt_PVGV)
/* if at top level, try UNIVERSAL */
if (level == 0 || level == -1) {
- HV* const lastchance = gv_stashpvn(STR_WITH_LEN("UNIVERSAL"), FALSE);
+ HV* const lastchance = gv_stashpvs("UNIVERSAL", FALSE);
if (lastchance) {
if ((gv = gv_fetchmeth(lastchance, name, len,
GV **gvp;
if (!stash)
- return Nullgv; /* UNIVERSAL::AUTOLOAD could cause trouble */
+ return NULL; /* UNIVERSAL::AUTOLOAD could cause trouble */
if (len == S_autolen && strnEQ(name, S_autoload, S_autolen))
- return Nullgv;
+ return NULL;
if (!(gv = gv_fetchmeth(stash, S_autoload, S_autolen, FALSE)))
- return Nullgv;
+ return NULL;
cv = GvCV(gv);
if (!(CvROOT(cv) || CvXSUB(cv)))
- return Nullgv;
+ return NULL;
/* Have an autoload */
if (level < 0) /* Cannot do without a stub */
gv_fetchmeth(stash, name, len, 0);
gvp = (GV**)hv_fetch(stash, name, len, (level >= 0));
if (!gvp)
- return Nullgv;
+ return NULL;
return *gvp;
}
return gv;
GV *
Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
{
+ dVAR;
register const char *nend;
const char *nsplit = NULL;
GV* gv;
if (!isGV(vargv)) {
gv_init(vargv, varstash, S_autoload, S_autolen, FALSE);
#ifdef PERL_DONT_CREATE_GVSV
- GvSV(vargv) = NEWSV(72,0);
+ GvSV(vargv) = newSV(0);
#endif
}
LEAVE;
S_require_errno(pTHX_ GV *gv)
{
dVAR;
- HV* stash = gv_stashpvn(STR_WITH_LEN("Errno"), FALSE);
+ HV* stash = gv_stashpvs("Errno", FALSE);
if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) {
dSP;
newSVpvs("Errno"), Nullsv);
LEAVE;
SPAGAIN;
- stash = gv_stashpvn(STR_WITH_LEN("Errno"), FALSE);
+ stash = gv_stashpvs("Errno", FALSE);
if (!stash || !(gv_fetchmethod(stash, "TIEHASH")))
Perl_croak(aTHX_ "Can't use %%! because Errno.pm is not available");
}
Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
I32 sv_type)
{
+ dVAR;
register const char *name = nambeg;
register GV *gv = NULL;
GV**gvp;
I32 len;
- register const char *namend;
+ register const char *name_cursor;
HV *stash = NULL;
const I32 no_init = flags & (GV_NOADD_NOINIT | GV_NOINIT);
const I32 no_expand = flags & GV_NOEXPAND;
- const I32 add = flags & ~SVf_UTF8 & ~GV_NOADD_NOINIT & ~GV_NOEXPAND;
-
- PERL_UNUSED_ARG(full_len);
+ const I32 add =
+ flags & ~SVf_UTF8 & ~GV_NOADD_NOINIT & ~GV_NOEXPAND & ~GV_NOTQUAL;
+ const char *const name_end = nambeg + full_len;
+ const char *const name_em1 = name_end - 1;
+
+ if (flags & GV_NOTQUAL) {
+ /* Caller promised that there is no stash, so we can skip the check. */
+ len = full_len;
+ goto no_stash;
+ }
- if (*name == '*' && isALPHA(name[1])) /* accidental stringify on a GV? */
+ if (full_len > 2 && *name == '*' && isALPHA(name[1])) {
+ /* accidental stringify on a GV? */
name++;
+ }
- for (namend = name; *namend; namend++) {
- if ((*namend == ':' && namend[1] == ':')
- || (*namend == '\'' && namend[1]))
+ for (name_cursor = name; name_cursor < name_end; name_cursor++) {
+ if ((*name_cursor == ':' && name_cursor < name_em1
+ && name_cursor[1] == ':')
+ || (*name_cursor == '\'' && name_cursor[1]))
{
if (!stash)
stash = PL_defstash;
if (!stash || !SvREFCNT(stash)) /* symbol table under destruction */
return Nullgv;
- len = namend - name;
+ len = name_cursor - name;
if (len > 0) {
char smallbuf[128];
char *tmpbuf;
stash = GvHV(gv) = newHV();
if (!HvNAME_get(stash))
- hv_name_set(stash, nambeg, namend - nambeg, 0);
+ hv_name_set(stash, nambeg, name_cursor - nambeg, 0);
}
- if (*namend == ':')
- namend++;
- namend++;
- name = namend;
- if (!*name)
- return gv ? gv : (GV*)*hv_fetch(PL_defstash, "main::", 6, TRUE);
+ if (*name_cursor == ':')
+ name_cursor++;
+ name_cursor++;
+ name = name_cursor;
+ if (name == name_end)
+ return gv ? gv : (GV*)*hv_fetchs(PL_defstash, "main::", TRUE);
}
}
- len = namend - name;
+ len = name_cursor - name;
/* No stash in name, so see how we can default */
if (!stash) {
- if (isIDFIRST_lazy(name)) {
+ no_stash:
+ if (len && isIDFIRST_lazy(name)) {
bool global = FALSE;
- /* name is always \0 terminated, and initial \0 wouldn't return
- true from isIDFIRST_lazy, so we know that name[1] is defined */
- switch (name[1]) {
- case '\0':
+ switch (len) {
+ case 1:
if (*name == '_')
global = TRUE;
break;
- case 'N':
- if (strEQ(name, "INC") || strEQ(name, "ENV"))
+ case 3:
+ if ((name[0] == 'I' && name[1] == 'N' && name[2] == 'C')
+ || (name[0] == 'E' && name[1] == 'N' && name[2] == 'V')
+ || (name[0] == 'S' && name[1] == 'I' && name[2] == 'G'))
global = TRUE;
break;
- case 'I':
- if (strEQ(name, "SIG"))
+ case 4:
+ if (name[0] == 'A' && name[1] == 'R' && name[2] == 'G'
+ && name[3] == 'V')
+ global = TRUE;
+ break;
+ case 5:
+ if (name[0] == 'S' && name[1] == 'T' && name[2] == 'D'
+ && name[3] == 'I' && name[4] == 'N')
global = TRUE;
break;
- case 'T':
- if (strEQ(name, "STDIN") || strEQ(name, "STDOUT") ||
- strEQ(name, "STDERR"))
+ case 6:
+ if ((name[0] == 'S' && name[1] == 'T' && name[2] == 'D')
+ &&((name[3] == 'O' && name[4] == 'U' && name[5] == 'T')
+ ||(name[3] == 'E' && name[4] == 'R' && name[5] == 'R')))
global = TRUE;
break;
- case 'R':
- if (strEQ(name, "ARGV") || strEQ(name, "ARGVOUT"))
+ case 7:
+ if (name[0] == 'A' && name[1] == 'R' && name[2] == 'G'
+ && name[3] == 'V' && name[4] == 'O' && name[5] == 'U'
+ && name[6] == 'T')
global = TRUE;
break;
}
if (strEQ(name2, "SA")) {
AV* const av = GvAVn(gv);
GvMULTI_on(gv);
- sv_magic((SV*)av, (SV*)gv, PERL_MAGIC_isa, Nullch, 0);
+ sv_magic((SV*)av, (SV*)gv, PERL_MAGIC_isa, NULL, 0);
/* NOTE: No support for tied ISA */
if ((add & GV_ADDMULTI) && strEQ(nambeg,"AnyDBM_File::ISA")
&& AvFILLp(av) == -1)
case '-':
{
AV* const av = GvAVn(gv);
- sv_magic((SV*)av, Nullsv, PERL_MAGIC_regdata, Nullch, 0);
+ sv_magic((SV*)av, Nullsv, PERL_MAGIC_regdata, NULL, 0);
SvREADONLY_on(av);
goto magicalize;
}
case '+':
{
AV* const av = GvAVn(gv);
- sv_magic((SV*)av, (SV*)av, PERL_MAGIC_regdata, Nullch, 0);
+ sv_magic((SV*)av, (SV*)av, PERL_MAGIC_regdata, NULL, 0);
SvREADONLY_on(av);
/* FALL THROUGH */
}
IO *
Perl_newIO(pTHX)
{
+ dVAR;
GV *iogv;
- IO * const io = (IO*)NEWSV(0,0);
+ IO * const io = (IO*)newSV(0);
sv_upgrade((SV *)io,SVt_PVIO);
/* This used to read SvREFCNT(io) = 1;
SvOBJECT_on(io);
/* Clear the stashcache because a new IO could overrule a package name */
hv_clear(PL_stashcache);
- iogv = gv_fetchpvn_flags("FileHandle::", 12, 0, SVt_PVHV);
+ iogv = gv_fetchpvs("FileHandle::", 0, SVt_PVHV);
/* unless exists($main::{FileHandle}) and defined(%main::FileHandle::) */
if (!(iogv && GvHV(iogv) && HvARRAY(GvHV(iogv))))
- iogv = gv_fetchpvn_flags("IO::Handle::", 12, TRUE, SVt_PVHV);
+ iogv = gv_fetchpvs("IO::Handle::", GV_ADD, SVt_PVHV);
SvSTASH_set(io, (HV*)SvREFCNT_inc(GvHV(iogv)));
return io;
}
void
Perl_gv_check(pTHX_ HV *stash)
{
+ dVAR;
register I32 i;
if (!HvARRAY(stash))
GV *
Perl_newGVgen(pTHX_ const char *pack)
{
+ dVAR;
return gv_fetchpv(Perl_form(aTHX_ "%s::_GEN_%ld", pack, (long)PL_gensym++),
TRUE, SVt_PVGV);
}
GP*
Perl_gp_ref(pTHX_ GP *gp)
{
+ dVAR;
if (!gp)
return (GP*)NULL;
gp->gp_refcnt++;
if (gp->gp_cvgen) {
/* multi-named GPs cannot be used for method cache */
SvREFCNT_dec(gp->gp_cv);
- gp->gp_cv = Nullcv;
+ gp->gp_cv = NULL;
gp->gp_cvgen = 0;
}
else {
void
Perl_gp_free(pTHX_ GV *gv)
{
+ dVAR;
GP* gp;
if (!gv || !(gp = GvGP(gv)))
int i;
for (i = 1; i < NofAMmeth; i++) {
CV * const cv = amtp->table[i];
- if (cv != Nullcv) {
+ if (cv != NULL) {
SvREFCNT_dec((SV *) cv);
- amtp->table[i] = Nullcv;
+ amtp->table[i] = NULL;
}
}
}
bool
Perl_Gv_AMupdate(pTHX_ HV *stash)
{
+ dVAR;
MAGIC* const mg = mg_find((SV*)stash, PERL_MAGIC_overload_table);
AMT * const amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL;
AMT amt;
amt.fallback=AMGfallNEVER;
for (i = 1; i < lim; i++)
- amt.table[i] = Nullcv;
+ amt.table[i] = NULL;
for (; i < NofAMmeth; i++) {
- const char *cooky = PL_AMG_names[i];
+ const char * const cooky = PL_AMG_names[i];
/* Human-readable form, for debugging: */
- const char *cp = (i >= DESTROY_amg ? cooky : AMG_id2name(i));
+ const char * const cp = (i >= DESTROY_amg ? cooky : AMG_id2name(i));
const STRLEN l = strlen(cooky);
DEBUG_o( Perl_deb(aTHX_ "Checking overloading of \"%s\" in package \"%.256s\"\n",
/* This is a hack to support autoloading..., while
knowing *which* methods were declared as overloaded. */
/* GvSV contains the name of the method. */
- GV *ngv = Nullgv;
+ GV *ngv = NULL;
SV *gvsv = GvSV(gv);
DEBUG_o( Perl_deb(aTHX_ "Resolving method \"%"SVf256\
CV*
Perl_gv_handler(pTHX_ HV *stash, I32 id)
{
+ dVAR;
MAGIC *mg;
AMT *amtp;
if (!stash || !HvNAME_get(stash))
- return Nullcv;
+ return NULL;
mg = mg_find((SV*)stash, PERL_MAGIC_overload_table);
if (!mg) {
do_update:
return ret;
}
- return Nullcv;
+ return NULL;
}
https://perl5.git.perl.org / perl5.git / blobdiff