Make srand treat "-1" as -1

[perl5.git] / pp.c

diff --git a/pp.c b/pp.c
index f7ea741..c3221d5 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -1970,7 +1970,7 @@ Perl_do_ncmp(pTHX_ SV* const left, SV * const right)
                    return (leftuv > (UV)rightiv) - (leftuv < (UV)rightiv);
                }
            }
-           /* NOTREACHED */
+           assert(0); /* NOTREACHED */
     }
 #endif
     {
@@ -2157,12 +2157,8 @@ PP(pp_negate)
     {
        SV * const sv = TOPs;
 
-        if( !SvNIOK( sv ) && looks_like_number( sv ) ){
-           SvIV_please_nomg( sv );
-        }   
-
-       if (SvIOK(sv) || (SvOKp(sv) == SVp_IOK)) {
-           /* It's publicly an integer, or privately just an integer */
+       if (SvIOK(sv) || (SvGMAGICAL(sv) && SvIOKp(sv))) {
+           /* It's publicly an integer */
        oops_its_an_int:
            if (SvIsUV(sv)) {
                if (SvIVX(sv) == IV_MIN) {
@@ -2195,16 +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 {
-               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
@@ -2664,7 +2658,28 @@ PP(pp_rand)
 PP(pp_srand)
 {
     dVAR; dSP; dTARGET;
-    const UV anum = (MAXARG < 1 || (!TOPs && !POPs)) ? seed() : POPu;
+    UV anum;
+
+    if (MAXARG >= 1 && (TOPs || POPs)) {
+        SV *top;
+        char *pv;
+        STRLEN len;
+        int flags;
+
+        top = POPs;
+        pv = SvPV(top, len);
+        flags = grok_number(pv, len, &anum);
+
+        if (!(flags & IS_NUMBER_IN_UV)) {
+            Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
+                             "Integer overflow in srand");
+            anum = UV_MAX;
+        }
+    }
+    else {
+        anum = seed();
+    }
+
     (void)seedDrand01((Rand_seed_t)anum);
     PL_srand_called = TRUE;
     if (anum)
@@ -3241,17 +3256,30 @@ PP(pp_chr)
     char *tmps;
     UV value;
 
-    if (((SvIOK_notUV(TOPs) && SvIV(TOPs) < 0)
+    SvGETMAGIC(TOPs);
+    if (((SvIOKp(TOPs) && !SvIsUV(TOPs) && SvIV_nomg(TOPs) < 0)
         ||
-        (SvNOK(TOPs) && SvNV(TOPs) < 0.0))) {
+        ((SvNOKp(TOPs) || (SvOK(TOPs) && !SvIsUV(TOPs)))
+         && SvNV_nomg(TOPs) < 0.0))) {
        if (IN_BYTES) {
-           value = POPu; /* chr(-1) eq chr(0xff), etc. */
+           value = SvUV_nomg(TOPs); /* chr(-1) eq chr(0xff), etc. */
+           (void)POPs;
        } else {
-           (void) POPs; /* Ignore the argument value. */
+           SV *top = POPs;
+           if (ckWARN(WARN_UTF8)) {
+               if (SvGMAGICAL(top)) {
+                   SV *top2 = sv_newmortal();
+                   sv_setsv_nomg(top2, top);
+                   top = top2;
+               }
+               Perl_warner(aTHX_ packWARN(WARN_UTF8),
+                          "Invalid negative number (%"SVf") in chr", top);
+           }
            value = UNICODE_REPLACEMENT;
        }
     } else {
-       value = POPu;
+       value = SvUV_nomg(TOPs);
+       (void)POPs;
     }
 
     SvUPGRADE(TARG,SVt_PV);
@@ -4408,8 +4436,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);
@@ -4497,8 +4524,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) {
@@ -4684,7 +4710,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;
     }
 
@@ -5937,7 +5963,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;
 }