X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/1c5d1ca7ee89d1e1782f94ae9883de9a1052a87d..601f18338612507d7579747105124d8ed063211e:/gv.c?ds=sidebyside

diff --git a/gv.c b/gv.c
index 02ac851..d06bb8d 100644
--- a/gv.c
+++ b/gv.c
@@ -1,7 +1,7 @@
 /*    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.
@@ -45,7 +45,7 @@ Perl_gv_SVadd(pTHX_ GV *gv)
     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
@@ -73,6 +73,7 @@ Perl_gv_HVadd(pTHX_ register GV *gv)
 GV *
 Perl_gv_IOadd(pTHX_ register GV *gv)
 {
+    dVAR;
     if (!gv || SvTYPE((SV*)gv) != SVt_PVGV) {
 
         /*
@@ -102,6 +103,7 @@ Perl_gv_IOadd(pTHX_ register GV *gv)
 GV *
 Perl_gv_fetchfile(pTHX_ const char *name)
 {
+    dVAR;
     char smallbuf[256];
     char *tmpbuf;
     STRLEN tmplen;
@@ -194,7 +196,7 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
 #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*
@@ -202,7 +204,7 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
     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);
@@ -251,6 +253,7 @@ S_gv_init_sv(pTHX_ GV *gv, I32 sv_type)
     case SVt_NULL:
     case SVt_PVCV:
     case SVt_PVFM:
+    case SVt_PVGV:
 	break;
     default:
 	(void)GvSVn(gv);
@@ -282,6 +285,7 @@ obtained from the GV with the C<GvCV> macro.
 GV *
 Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
 {
+    dVAR;
     AV* av;
     GV* topgv;
     GV* gv;
@@ -292,7 +296,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
     /* 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;
     }
 
@@ -320,14 +324,14 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
 		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 */
@@ -339,9 +343,9 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
 
 	    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)
@@ -375,7 +379,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
     /* 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,
@@ -432,20 +436,20 @@ Perl_gv_fetchmeth_autoload(pTHX_ HV *stash, const char *name, STRLEN len, I32 le
 	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;
@@ -482,6 +486,7 @@ C<call_sv> apply equally to these functions.
 GV *
 Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
 {
+    dVAR;
     register const char *nend;
     const char *nsplit = NULL;
     GV* gv;
@@ -620,7 +625,7 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
     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;
@@ -639,7 +644,7 @@ STATIC void
 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;
@@ -650,7 +655,7 @@ S_require_errno(pTHX_ GV *gv)
                          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");
     }
@@ -748,31 +753,42 @@ GV *
 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;
@@ -802,47 +818,57 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 		    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;
 	    }
@@ -964,7 +990,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 		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)
@@ -1107,7 +1133,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 	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;
 	}
@@ -1124,7 +1150,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 	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 */
 	}
@@ -1237,8 +1263,9 @@ Perl_gv_efullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain
 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;
@@ -1248,10 +1275,10 @@ Perl_newIO(pTHX)
     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;
 }
@@ -1259,6 +1286,7 @@ Perl_newIO(pTHX)
 void
 Perl_gv_check(pTHX_ HV *stash)
 {
+    dVAR;
     register I32 i;
 
     if (!HvARRAY(stash))
@@ -1310,6 +1338,7 @@ Perl_gv_check(pTHX_ HV *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);
 }
@@ -1319,6 +1348,7 @@ Perl_newGVgen(pTHX_ const char *pack)
 GP*
 Perl_gp_ref(pTHX_ GP *gp)
 {
+    dVAR;
     if (!gp)
 	return (GP*)NULL;
     gp->gp_refcnt++;
@@ -1326,7 +1356,7 @@ Perl_gp_ref(pTHX_ GP *gp)
 	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 {
@@ -1340,6 +1370,7 @@ Perl_gp_ref(pTHX_ GP *gp)
 void
 Perl_gp_free(pTHX_ GV *gv)
 {
+    dVAR;
     GP* gp;
 
     if (!gv || !(gp = GvGP(gv)))
@@ -1390,9 +1421,9 @@ Perl_magic_freeovrld(pTHX_ SV *sv, MAGIC *mg)
 	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;
 	    }
 	}
     }
@@ -1404,6 +1435,7 @@ Perl_magic_freeovrld(pTHX_ SV *sv, MAGIC *mg)
 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;
@@ -1445,11 +1477,11 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
 	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",
@@ -1473,7 +1505,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
 		/* 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\
@@ -1526,11 +1558,12 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
 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:
@@ -1556,7 +1589,7 @@ Perl_gv_handler(pTHX_ HV *stash, I32 id)
 	return ret;
     }
 
-    return Nullcv;
+    return NULL;
 }