This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix UV_SIZEOF to UVSIZE; change the overflow tests
[perl5.git] / gv.c
diff --git a/gv.c b/gv.c
index e531204..ae76f82 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -609,12 +609,15 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
 
     /* Adding a new symbol */
 
-    if (add & GV_ADDWARN)
-       Perl_warn(aTHX_ "Had to create %s unexpectedly", nambeg);
+    if (add & GV_ADDWARN && ckWARN_d(WARN_INTERNAL))
+       Perl_warner(aTHX_ WARN_INTERNAL, "Had to create %s unexpectedly", nambeg);
     gv_init(gv, stash, name, len, add & GV_ADDMULTI);
     gv_init_sv(gv, sv_type);
     GvFLAGS(gv) |= add_gvflags;
 
+    if (isLEXWARN_on && isALPHA(name[0]) && ! ckWARN(WARN_ONCE))
+        GvMULTI_on(gv) ;
+
     /* set up magic where warranted */
     switch (*name) {
     case 'A':
@@ -674,6 +677,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)
@@ -715,7 +722,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");
@@ -754,7 +761,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':
@@ -764,7 +770,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;
@@ -772,6 +777,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)
@@ -944,13 +953,16 @@ Perl_gp_ref(pTHX_ GP *gp)
 void
 Perl_gp_free(pTHX_ GV *gv)
 {
+    dTHR;  
     GP* gp;
     CV* cv;
 
     if (!gv || !(gp = GvGP(gv)))
        return;
     if (gp->gp_refcnt == 0) {
-        Perl_warn(aTHX_ "Attempt to free unreferenced glob pointers");
+       if (ckWARN_d(WARN_INTERNAL))
+           Perl_warner(aTHX_ WARN_INTERNAL,
+                       "Attempt to free unreferenced glob pointers");
         return;
     }
     if (gp->gp_cv) {
@@ -1462,7 +1474,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) {