[perl #112966] Crash on delete local; other local bugs

[perl5.git] / pp.c

diff --git a/pp.c b/pp.c
index 8d2ee2a..d44b4ee 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -432,6 +432,7 @@ PP(pp_prototype)
     GV *gv;
     SV *ret = &PL_sv_undef;
 
+    if (SvGMAGICAL(TOPs)) SETs(sv_mortalcopy(TOPs));
     if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) {
        const char * s = SvPVX_const(TOPs);
        if (strnEQ(s, "CORE::", 6)) {
@@ -1023,11 +1024,7 @@ PP(pp_pow)
     /* For integer to integer power, we do the calculation by hand wherever
        we're sure it is safe; otherwise we call pow() and try to convert to
        integer afterwards. */
-    {
-       SvIV_please_nomg(svr);
-       if (SvIOK(svr)) {
-           SvIV_please_nomg(svl);
-           if (SvIOK(svl)) {
+    if (SvIV_please_nomg(svr) && SvIV_please_nomg(svl)) {
                UV power;
                bool baseuok;
                UV baseuv;
@@ -1125,8 +1122,6 @@ PP(pp_pow)
                        RETURN;
                    } 
                }
-           }
-       }
     }
   float_it:
 #endif    
@@ -1190,14 +1185,12 @@ PP(pp_multiply)
     svr = TOPs;
     svl = TOPm1s;
 #ifdef PERL_PRESERVE_IVUV
-    SvIV_please_nomg(svr);
-    if (SvIOK(svr)) {
+    if (SvIV_please_nomg(svr)) {
        /* Unless the left argument is integer in range we are going to have to
           use NV maths. Hence only attempt to coerce the right argument if
           we know the left is integer.  */
        /* Left operand is defined, so is it IV? */
-       SvIV_please_nomg(svl);
-       if (SvIOK(svl)) {
+       if (SvIV_please_nomg(svl)) {
            bool auvok = SvUOK(svl);
            bool buvok = SvUOK(svr);
            const UV topmask = (~ (UV)0) << (4 * sizeof (UV));
@@ -1335,10 +1328,7 @@ PP(pp_divide)
 #endif
 
 #ifdef PERL_TRY_UV_DIVIDE
-    SvIV_please_nomg(svr);
-    if (SvIOK(svr)) {
-        SvIV_please_nomg(svl);
-        if (SvIOK(svl)) {
+    if (SvIV_please_nomg(svr) && SvIV_please_nomg(svl)) {
             bool left_non_neg = SvUOK(svl);
             bool right_non_neg = SvUOK(svr);
             UV left;
@@ -1413,8 +1403,7 @@ PP(pp_divide)
                     RETURN;
                 } /* tried integer divide but it was not an integer result */
             } /* else (PERL_ABS(result) < 1.0) or (both UVs in range for NV) */
-        } /* left wasn't SvIOK */
-    } /* right wasn't SvIOK */
+    } /* one operand wasn't SvIOK */
 #endif /* PERL_TRY_UV_DIVIDE */
     {
        NV right = SvNV_nomg(svr);
@@ -1446,8 +1435,7 @@ PP(pp_modulo)
        NV dleft  = 0.0;
        SV * const svr = TOPs;
        SV * const svl = TOPm1s;
-       SvIV_please_nomg(svr);
-        if (SvIOK(svr)) {
+        if (SvIV_please_nomg(svr)) {
             right_neg = !SvUOK(svr);
             if (!right_neg) {
                 right = SvUVX(svr);
@@ -1477,9 +1465,7 @@ PP(pp_modulo)
         /* At this point use_double is only true if right is out of range for
            a UV.  In range NV has been rounded down to nearest UV and
            use_double false.  */
-        SvIV_please_nomg(svl);
-       if (!use_double && SvIOK(svl)) {
-            if (SvIOK(svl)) {
+       if (!use_double && SvIV_please_nomg(svl)) {
                 left_neg = !SvUOK(svl);
                 if (!left_neg) {
                     left = SvUVX(svl);
@@ -1492,7 +1478,6 @@ PP(pp_modulo)
                         left = -aiv;
                     }
                 }
-            }
         }
        else {
            dleft = SvNV_nomg(svl);
@@ -1707,8 +1692,7 @@ PP(pp_subtract)
 #ifdef PERL_PRESERVE_IVUV
     /* See comments in pp_add (in pp_hot.c) about Overflow, and how
        "bad things" happen if you rely on signed integers wrapping.  */
-    SvIV_please_nomg(svr);
-    if (SvIOK(svr)) {
+    if (SvIV_please_nomg(svr)) {
        /* Unless the left argument is integer in range we are going to have to
           use NV maths. Hence only attempt to coerce the right argument if
           we know the left is integer.  */
@@ -1722,8 +1706,7 @@ PP(pp_subtract)
            /* left operand is undef, treat as zero.  */
        } else {
            /* Left operand is defined, so is it IV? */
-           SvIV_please_nomg(svl);
-           if (SvIOK(svl)) {
+           if (SvIV_please_nomg(svl)) {
                if ((auvok = SvUOK(svl)))
                    auv = SvUVX(svl);
                else {
@@ -1951,11 +1934,8 @@ Perl_do_ncmp(pTHX_ SV* const left, SV * const right)
 
     PERL_ARGS_ASSERT_DO_NCMP;
 #ifdef PERL_PRESERVE_IVUV
-    SvIV_please_nomg(right);
     /* Fortunately it seems NaN isn't IOK */
-    if (SvIOK(right)) {
-       SvIV_please_nomg(left);
-       if (SvIOK(left)) {
+    if (SvIV_please_nomg(right) && SvIV_please_nomg(left)) {
            if (!SvUOK(left)) {
                const IV leftiv = SvIVX(left);
                if (!SvUOK(right)) {
@@ -1990,8 +1970,7 @@ Perl_do_ncmp(pTHX_ SV* const left, SV * const right)
                    return (leftuv > (UV)rightiv) - (leftuv < (UV)rightiv);
                }
            }
-           /* NOTREACHED */
-       }
+           assert(0); /* NOTREACHED */
     }
 #endif
     {
@@ -2177,14 +2156,9 @@ PP(pp_negate)
     tryAMAGICun_MG(neg_amg, AMGf_numeric);
     {
        SV * const sv = TOPs;
-       const int flags = SvFLAGS(sv);
-
-        if( !SvNIOK( sv ) && looks_like_number( sv ) ){
-           SvIV_please( sv );
-        }   
 
-       if ((flags & SVf_IOK) || ((flags & (SVp_IOK | SVp_NOK)) == SVp_IOK)) {
-           /* It's publicly an integer, or privately an integer-not-float */
+       if (SvIOK(sv) || (SvGMAGICAL(sv) && SvIOKp(sv))) {
+           /* It's publicly an integer */
        oops_its_an_int:
            if (SvIsUV(sv)) {
                if (SvIVX(sv) == IV_MIN) {
@@ -2208,7 +2182,7 @@ PP(pp_negate)
            }
 #endif
        }
-       if (SvNIOKp(sv))
+       if (SvNIOKp(sv) && (SvNIOK(sv) || !SvPOK(sv)))
            SETn(-SvNV_nomg(sv));
        else if (SvPOKp(sv)) {
            STRLEN len;
@@ -2217,27 +2191,14 @@ PP(pp_negate)
                sv_setpvs(TARG, "-");
                sv_catsv(TARG, sv);
            }
-           else if (*s == '+' || *s == '-') {
+           else if (*s == '+' || (*s == '-' && !looks_like_number(sv))) {
                sv_setsv_nomg(TARG, sv);
                *SvPV_force_nomg(TARG, len) = *s == '-' ? '+' : '-';
            }
-           else if (DO_UTF8(sv)) {
-               SvIV_please_nomg(sv);
-               if (SvIOK(sv))
-                   goto oops_its_an_int;
-               if (SvNOK(sv))
-                   sv_setnv(TARG, -SvNV_nomg(sv));
-               else {
-                   sv_setpvs(TARG, "-");
-                   sv_catsv(TARG, sv);
-               }
-           }
-           else {
-               SvIV_please_nomg(sv);
-               if (SvIOK(sv))
+           else if (SvIV_please_nomg(sv))
                  goto oops_its_an_int;
+           else
                sv_setnv(TARG, -SvNV_nomg(sv));
-           }
            SETTARG;
        }
        else
@@ -4441,8 +4402,7 @@ S_do_delete_local(pTHX)
        SV * const osv = POPs;
        const bool tied = SvRMAGICAL(osv)
                            && mg_find((const SV *)osv, PERL_MAGIC_tied);
-       const bool can_preserve = SvCANEXISTDELETE(osv)
-                                   || mg_find((const SV *)osv, PERL_MAGIC_env);
+       const bool can_preserve = SvCANEXISTDELETE(osv);
        const U32 type = SvTYPE(osv);
        if (type == SVt_PVHV) {                 /* hash element */
            HV * const hv = MUTABLE_HV(osv);
@@ -4530,8 +4490,7 @@ S_do_delete_local(pTHX)
        SV * const osv   = POPs;
        const bool tied = SvRMAGICAL(osv)
                            && mg_find((const SV *)osv, PERL_MAGIC_tied);
-       const bool can_preserve = SvCANEXISTDELETE(osv)
-                                   || mg_find((const SV *)osv, PERL_MAGIC_env);
+       const bool can_preserve = SvCANEXISTDELETE(osv);
        const U32 type = SvTYPE(osv);
        SV *sv = NULL;
        if (type == SVt_PVHV) {
@@ -4717,7 +4676,7 @@ PP(pp_hslice)
         MAGIC *mg;
         HV *stash;
 
-       if (SvCANEXISTDELETE(hv) || mg_find((const SV *)hv, PERL_MAGIC_env))
+       if (SvCANEXISTDELETE(hv))
            can_preserve = TRUE;
     }
 
@@ -5970,7 +5929,7 @@ PP(pp_runcv)
        oldsi->si_cxix = oldcxix;
     }
     else cv = find_runcv(NULL);
-    XPUSHs(CvUNIQUE(cv) ? &PL_sv_undef : sv_2mortal(newRV((SV *)cv)));
+    XPUSHs(CvEVAL(cv) ? &PL_sv_undef : sv_2mortal(newRV((SV *)cv)));
     RETURN;
 }