/* 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)
{
- if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
- Perl_croak(aTHX_ "Bad symbol for filehandle");
+ dVAR;
+ if (!gv || SvTYPE((SV*)gv) != SVt_PVGV) {
+
+ /*
+ * if it walks like a dirhandle, then let's assume that
+ * this is a dirhandle.
+ */
+ const char *fh = PL_op->op_type == OP_READDIR ||
+ PL_op->op_type == OP_TELLDIR ||
+ PL_op->op_type == OP_SEEKDIR ||
+ PL_op->op_type == OP_REWINDDIR ||
+ PL_op->op_type == OP_CLOSEDIR ?
+ "dirhandle" : "filehandle";
+ Perl_croak(aTHX_ "Bad symbol for %s", fh);
+ }
+
if (!GvIOp(gv)) {
#ifdef GV_UNIQUE_CHECK
if (GvUNIQUE(gv)) {
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*
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("UNIVERSAL", 9, FALSE)))
+ if(!(stash = gv_stashpvs("UNIVERSAL", FALSE)))
return 0;
}
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("UNIVERSAL", 9, 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;
varsv = GvSVn(vargv);
sv_setpvn(varsv, packname, packname_len);
- sv_catpvn(varsv, "::", 2);
+ sv_catpvs(varsv, "::");
sv_catpvn(varsv, name, len);
SvTAINTED_off(varsv);
return gv;
S_require_errno(pTHX_ GV *gv)
{
dVAR;
- HV* stash = gv_stashpvn("Errno",5,FALSE);
+ HV* stash = gv_stashpvs("Errno", FALSE);
if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) {
dSP;
ENTER;
save_scalar(gv); /* keep the value of $! */
Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
- newSVpvn("Errno",5), Nullsv);
+ newSVpvs("Errno"), Nullsv);
LEAVE;
SPAGAIN;
- stash = gv_stashpvn("Errno",5,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;
namend++;
name = namend;
if (!*name)
- return gv ? gv : (GV*)*hv_fetch(PL_defstash, "main::", 6, TRUE);
+ return gv ? gv : (GV*)*hv_fetchs(PL_defstash, "main::", TRUE);
}
}
len = namend - name;
if (keepmain || strNE(name, "main")) {
sv_catpvn(sv,name,namelen);
- sv_catpvn(sv,"::", 2);
+ sv_catpvs(sv,"::");
}
sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv));
}
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;
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++;
void
Perl_gp_free(pTHX_ GV *gv)
{
+ dVAR;
GP* gp;
if (!gv || !(gp = GvGP(gv)))
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;
for (i = 1; i < lim; i++)
amt.table[i] = Nullcv;
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;
projects / p5sagit/p5-mst-13.2.git / blobdiff