X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=gv.c;h=d25711408b08625025cfe60ab41078fff6b06c3f;hb=54e82ce5cfd72fcdc60806373e0c4d6890b68a3c;hp=d1cf7ae62af33bdd17cbdeb894b37e8406c846e8;hpb=0453d815b8a74697ff1e5451c27aba2fe537b8e0;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/gv.c b/gv.c
index d1cf7ae..d257114 100644
--- a/gv.c
+++ b/gv.c
@@ -531,6 +531,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
 	    else if ((COP*)PL_curcop == &PL_compiling) {
 		stash = PL_curstash;
 		if (add && (PL_hints & HINT_STRICT_VARS) &&
+		    !(add & GV_ADDOUR) &&
 		    sv_type != SVt_PVCV &&
 		    sv_type != SVt_PVGV &&
 		    sv_type != SVt_PVFM &&
@@ -568,26 +569,15 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
     /* By this point we should have a stash and a name */
 
     if (!stash) {
-	if (!add)
-	    return Nullgv;
-	{
-	    char sv_type_char = ((sv_type == SVt_PV) ? '$'
-				 : (sv_type == SVt_PVAV) ? '@'
-				 : (sv_type == SVt_PVHV) ? '%'
-				 : 0);
-	    if (sv_type_char) 
-		Perl_warn(aTHX_ "Global symbol \"%c%s\" requires explicit package name",
-		     sv_type_char, name);
-	    else
-		Perl_warn(aTHX_ "Global symbol \"%s\" requires explicit package name",
-		     name);
+	if (add) {
+	    qerror(Perl_mess(aTHX_
+		 "Global symbol \"%s%s\" requires explicit package name",
+		 (sv_type == SVt_PV ? "$"
+		  : sv_type == SVt_PVAV ? "@"
+		  : sv_type == SVt_PVHV ? "%"
+		  : ""), name));
 	}
-	++PL_error_count;
-	stash = PL_curstash ? PL_curstash : PL_defstash;	/* avoid core dumps */
-	add_gvflags = ((sv_type == SVt_PV) ? GVf_IMPORTED_SV
-		       : (sv_type == SVt_PVAV) ? GVf_IMPORTED_AV
-		       : (sv_type == SVt_PVHV) ? GVf_IMPORTED_HV
-		       : 0);
+	return Nullgv;
     }
 
     if (!SvREFCNT(stash))	/* symbol table under destruction */
@@ -677,6 +667,10 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
 	    }
 	}
 	break;
+    case 'V':
+	if (strEQ(name, "VERSION"))
+	    GvMULTI_on(gv);
+	break;
 
     case '&':
 	if (len > 1)
@@ -718,7 +712,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
 	    break;
 	if (sv_type > SVt_PV && PL_curcop != &PL_compiling) {
 	    HV* stash = gv_stashpvn("Errno",5,FALSE);
-	    if(!stash || !(gv_fetchmethod(stash, "TIEHASH"))) {
+	    if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) {
 		dSP;
 		PUTBACK;
 		require_pv("Errno.pm");
@@ -757,7 +751,6 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
     case '/':
     case '|':
     case '\001':
-    case '\002':
     case '\003':
     case '\004':
     case '\005':
@@ -767,7 +760,6 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
     case '\017':
     case '\020':
     case '\024':
-    case '\027':
 	if (len > 1)
 	    break;
 	goto magicalize;
@@ -775,6 +767,10 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
 	if (len > 1)
 	    break;
 	goto ro_magicalize;
+    case '\027':	/* $^W & $^Warnings */
+	if (len > 1 && strNE(name, "\027arnings"))
+	    break;
+	goto magicalize;
 
     case '+':
 	if (len > 1)
@@ -947,14 +943,16 @@ Perl_gp_ref(pTHX_ GP *gp)
 void
 Perl_gp_free(pTHX_ GV *gv)
 {
+    dTHR;  
     GP* gp;
     CV* cv;
-    dTHR;  
 
     if (!gv || !(gp = GvGP(gv)))
 	return;
-    if (gp->gp_refcnt == 0 && ckWARN_d(WARN_INTERNAL)) {
-        Perl_warner(aTHX_ WARN_INTERNAL, "Attempt to free unreferenced glob pointers");
+    if (gp->gp_refcnt == 0) {
+	if (ckWARN_d(WARN_INTERNAL))
+	    Perl_warner(aTHX_ WARN_INTERNAL,
+			"Attempt to free unreferenced glob pointers");
         return;
     }
     if (gp->gp_cv) {
@@ -1466,7 +1464,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
       case dec_amg:
 	SvSetSV(left,res); return left;
       case not_amg:
-	ans=!SvOK(res); break;
+	ans=!SvTRUE(res); break;
       }
       return boolSV(ans);
     } else if (method==copy_amg) {