X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=gv.c;h=71ec31d9a039dd95b8211681aacb6f6bd99f9efe;hb=974c90c5029395da8217586c87921d37914f57c1;hp=462002c5d5ec8e3b01584e3a0ebf9afa96ccc53c;hpb=07766739ad671051f274806a83c05be36e7ca89a;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/gv.c b/gv.c
index 462002c..71ec31d 100644
--- a/gv.c
+++ b/gv.c
@@ -80,7 +80,7 @@ Perl_gv_fetchfile(pTHX_ const char *name)
 	gv_init(gv, PL_defstash, tmpbuf, tmplen, FALSE);
 	sv_setpv(GvSV(gv), name);
 	if (PERLDB_LINE)
-	    hv_magic(GvHVn(gv_AVadd(gv)), Nullgv, 'L');
+	    hv_magic(GvHVn(gv_AVadd(gv)), Nullgv, PERL_MAGIC_dbfile);
     }
     if (tmpbuf != smallbuf)
 	Safefree(tmpbuf);
@@ -110,7 +110,7 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
     GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : "";
     GvCVGEN(gv) = 0;
     GvEGV(gv) = gv;
-    sv_magic((SV*)gv, (SV*)gv, '*', Nullch, 0);
+    sv_magic((SV*)gv, (SV*)gv, PERL_MAGIC_glob, Nullch, 0);
     GvSTASH(gv) = (HV*)SvREFCNT_inc(stash);
     GvNAME(gv) = savepvn(name, len);
     GvNAMELEN(gv) = len;
@@ -188,10 +188,13 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
     GV** gvp;
     CV* cv;
 
-    if (!stash)
-	return 0;
-    if (!HvNAME(stash))
-        Perl_croak(aTHX_ "Can't use anonymous symbol table for method lookup");
+    /* UNIVERSAL methods should be callable without a stash */
+    if (!stash) {
+	level = -1;  /* probably appropriate */
+	if(!(stash = gv_stashpvn("UNIVERSAL", 9, FALSE)))
+	    return 0;
+    }
+
     if ((level > 100) || (level < -100))
 	Perl_croak(aTHX_ "Recursive inheritance detected while looking for method '%s' in package '%s'",
 	      name, HvNAME(stash));
@@ -365,12 +368,14 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
 	    /* ->SUPER::method should really be looked up in original stash */
 	    SV *tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_ "%s::SUPER",
 						  CopSTASHPV(PL_curcop)));
+	    /* __PACKAGE__::SUPER stash should be autovivified */
 	    stash = gv_stashpvn(SvPVX(tmpstr), SvCUR(tmpstr), TRUE);
 	    DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
 			 origname, HvNAME(stash), name) );
 	}
 	else
-	    stash = gv_stashpvn(origname, nsplit - origname, TRUE);
+            /* don't autovifify if ->NoSuchStash::method */
+            stash = gv_stashpvn(origname, nsplit - origname, FALSE);
     }
 
     gv = gv_fetchmeth(stash, name, nend - name, 0);
@@ -414,6 +419,8 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
     GV* vargv;
     SV* varsv;
 
+    if (!stash)
+	return Nullgv;	/* UNIVERSAL::AUTOLOAD could cause trouble */
     if (len == autolen && strnEQ(name, autoload, autolen))
 	return Nullgv;
     if (!(gv = gv_fetchmeth(stash, autoload, autolen, FALSE)))
@@ -752,7 +759,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
 	if (strEQ(name, "ISA")) {
 	    AV* av = GvAVn(gv);
 	    GvMULTI_on(gv);
-	    sv_magic((SV*)av, (SV*)gv, 'I', Nullch, 0);
+	    sv_magic((SV*)av, (SV*)gv, PERL_MAGIC_isa, Nullch, 0);
 	    /* NOTE: No support for tied ISA */
 	    if ((add & GV_ADDMULTI) && strEQ(nambeg,"AnyDBM_File::ISA")
 		&& AvFILLp(av) == -1)
@@ -775,7 +782,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
         if (strEQ(name, "OVERLOAD")) {
             HV* hv = GvHVn(gv);
             GvMULTI_on(gv);
-            hv_magic(hv, Nullgv, 'A');
+            hv_magic(hv, Nullgv, PERL_MAGIC_overload);
         }
         break;
     case 'S':
@@ -789,7 +796,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
 	    }
 	    GvMULTI_on(gv);
 	    hv = GvHVn(gv);
-	    hv_magic(hv, Nullgv, 'S');
+	    hv_magic(hv, Nullgv, PERL_MAGIC_sig);
 	    for (i = 1; i < SIG_SIZE; i++) {
 	    	SV ** init;
 	    	init = hv_fetch(hv, PL_sig_name[i], strlen(PL_sig_name[i]), 1);
@@ -848,7 +855,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
 	   now (rather than going to magicalize)
 	*/
 
-	sv_magic(GvSV(gv), (SV*)gv, 0, name, len);
+	sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, len);
 
 	if (sv_type == SVt_PVHV)
 	    require_errno(gv);
@@ -859,7 +866,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
 	    break;
 	else {
             AV* av = GvAVn(gv);
-            sv_magic((SV*)av, Nullsv, 'D', Nullch, 0);
+            sv_magic((SV*)av, Nullsv, PERL_MAGIC_regdata, Nullch, 0);
 	    SvREADONLY_on(av);
         }
 	goto magicalize;
@@ -917,7 +924,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
 	    break;
 	else {
             AV* av = GvAVn(gv);
-            sv_magic((SV*)av, (SV*)av, 'D', Nullch, 0);
+            sv_magic((SV*)av, (SV*)av, PERL_MAGIC_regdata, Nullch, 0);
 	    SvREADONLY_on(av);
         }
 	/* FALL THROUGH */
@@ -933,7 +940,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
       ro_magicalize:
 	SvREADONLY_on(GvSV(gv));
       magicalize:
-	sv_magic(GvSV(gv), (SV*)gv, 0, name, len);
+	sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, len);
 	break;
 
     case '\014':	/* $^L */
@@ -1068,7 +1075,7 @@ Perl_gv_check(pTHX_ HV *stash)
     for (i = 0; i <= (I32) HvMAX(stash); i++) {
 	for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
 	    if (HeKEY(entry)[HeKLEN(entry)-1] == ':' &&
-		(gv = (GV*)HeVAL(entry)) && (hv = GvHV(gv)) && HvNAME(hv))
+		(gv = (GV*)HeVAL(entry)) && (hv = GvHV(gv)))
 	    {
 		if (hv != PL_defstash && hv != stash)
 		     gv_check(hv);              /* nested package */
@@ -1218,15 +1225,14 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
 {
   GV* gv;
   CV* cv;
-  MAGIC* mg=mg_find((SV*)stash,'c');
+  MAGIC* mg=mg_find((SV*)stash, PERL_MAGIC_overload_table);
   AMT *amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL;
   AMT amt;
-  STRLEN n_a;
 
   if (mg && amtp->was_ok_am == PL_amagic_generation
       && amtp->was_ok_sub == PL_sub_generation)
       return AMT_OVERLOADED(amtp);
-  sv_unmagic((SV*)stash, 'c');
+  sv_unmagic((SV*)stash, PERL_MAGIC_overload_table);
 
   DEBUG_o( Perl_deb(aTHX_ "Recalcing overload magic in package %s\n",HvNAME(stash)) );
 
@@ -1275,7 +1281,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
 		GV *ngv;
 		
 		DEBUG_o( Perl_deb(aTHX_ "Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n",
-			     SvPV(GvSV(gv), n_a), cp, HvNAME(stash)) );
+			     SvPV_nolen(GvSV(gv)), cp, HvNAME(stash)) );
 		if (!SvPOK(GvSV(gv))
 		    || !(ngv = gv_fetchmethod_autoload(stash, SvPVX(GvSV(gv)),
 						       FALSE)))
@@ -1305,14 +1311,16 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
       AMT_AMAGIC_on(&amt);
       if (have_ovl)
 	  AMT_OVERLOADED_on(&amt);
-      sv_magic((SV*)stash, 0, 'c', (char*)&amt, sizeof(AMT));
+      sv_magic((SV*)stash, 0, PERL_MAGIC_overload_table,
+						(char*)&amt, sizeof(AMT));
       return have_ovl;
     }
   }
   /* Here we have no table: */
   /* no_table: */
   AMT_AMAGIC_off(&amt);
-  sv_magic((SV*)stash, 0, 'c', (char*)&amt, sizeof(AMTS));
+  sv_magic((SV*)stash, 0, PERL_MAGIC_overload_table,
+						(char*)&amt, sizeof(AMTS));
   return FALSE;
 }
 
@@ -1325,11 +1333,11 @@ Perl_gv_handler(pTHX_ HV *stash, I32 id)
 
     if (!stash)
         return Nullcv;
-    mg = mg_find((SV*)stash,'c');
+    mg = mg_find((SV*)stash, PERL_MAGIC_overload_table);
     if (!mg) {
       do_update:
 	Gv_AMupdate(stash);
-	mg = mg_find((SV*)stash,'c');
+	mg = mg_find((SV*)stash, PERL_MAGIC_overload_table);
     }
     amtp = (AMT*)mg->mg_ptr;
     if ( amtp->was_ok_am != PL_amagic_generation
@@ -1345,14 +1353,15 @@ SV*
 Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
 {
   MAGIC *mg;
-  CV *cv;
+  CV *cv=NULL;
   CV **cvp=NULL, **ocvp=NULL;
-  AMT *amtp, *oamtp;
-  int fl=0, off, off1, lr=0, assign=AMGf_assign & flags, notfound=0;
+  AMT *amtp=NULL, *oamtp=NULL;
+  int fl=0, off=0, off1, lr=0, assign=AMGf_assign & flags, notfound=0;
   int postpr = 0, force_cpy = 0, assignshift = assign ? 1 : 0;
-  HV* stash;
+  HV* stash=NULL;
   if (!(AMGf_noleft & flags) && SvAMAGIC(left)
-      && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(left))),'c'))
+      && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(left))),
+			PERL_MAGIC_overload_table))
       && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr)
 			? (oamtp = amtp = (AMT*)mg->mg_ptr)->table
 			: (CV **) NULL))
@@ -1465,7 +1474,8 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
 	 }
 	 if (!cv) goto not_found;
     } else if (!(AMGf_noright & flags) && SvAMAGIC(right)
-	       && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(right))),'c'))
+	       && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(right))),
+			PERL_MAGIC_overload_table))
 	       && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr)
 			  ? (amtp = (AMT*)mg->mg_ptr)->table
 			  : (CV **) NULL))
@@ -1634,7 +1644,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
     CATCH_SET(oldcatch);
 
     if (postpr) {
-      int ans;
+      int ans=0;
       switch (method) {
       case le_amg:
       case sle_amg: