X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=gv.c;h=462002c5d5ec8e3b01584e3a0ebf9afa96ccc53c;hb=a02608dec28d4e964c218e69ee3e39c623232d8d;hp=c73d503d5f4776d5db92d648996721dd489be78f;hpb=b82d478d407f1381d69179104035c975c1d1402e;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/gv.c b/gv.c
index c73d503..462002c 100644
--- a/gv.c
+++ b/gv.c
@@ -45,8 +45,14 @@ Perl_gv_IOadd(pTHX_ register GV *gv)
 {
     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;
 }
 
@@ -119,7 +125,7 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
 	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
@@ -157,7 +163,7 @@ S_gv_init_sv(pTHX_ GV *gv, I32 sv_type)
 
 Returns the glob with the given C<name> and a defined subroutine or
 C<NULL>.  The glob lives in the given C<stash>, or in the stashes
-accessible via @ISA and @UNIVERSAL.
+accessible via @ISA and UNIVERSAL::.
 
 The argument C<level> should be either 0 or -1.  If C<level==0>, as a
 side-effect creates a glob with the given C<name> in the given C<stash>
@@ -184,6 +190,8 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
 
     if (!stash)
 	return 0;
+    if (!HvNAME(stash))
+        Perl_croak(aTHX_ "Can't use anonymous symbol table for method lookup");
     if ((level > 100) || (level < -100))
 	Perl_croak(aTHX_ "Recursive inheritance detected while looking for method '%s' in package '%s'",
 	      name, HvNAME(stash));
@@ -465,6 +473,28 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
     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
 
@@ -688,6 +718,8 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
 	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) {
@@ -701,7 +733,8 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
     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 */
@@ -808,19 +841,19 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
     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;
@@ -1050,7 +1083,12 @@ Perl_gv_check(pTHX_ HV *stash)
 		 * module, don't bother warning */
 		if (file
 		    && PERL_FILE_IS_ABSOLUTE(file)
-		    && (instr(file, "/lib/") || instr(file, ".pm")))
+#ifdef MACOS_TRADITIONAL
+		    && (instr(file, ":lib:")
+#else
+		    && (instr(file, "/lib/")
+#endif
+		    || instr(file, ".pm")))
 		{
 		    continue;
 		}
@@ -1201,7 +1239,6 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
   {
     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 */
@@ -1273,7 +1310,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
     }
   }
   /* 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;
@@ -1283,7 +1320,6 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
 CV*
 Perl_gv_handler(pTHX_ HV *stash, I32 id)
 {
-    dTHR;
     MAGIC *mg;
     AMT *amtp;