Don’t skip t/re/reg_eval_scope.t under miniperl

[perl5.git] / pp.c

diff --git a/pp.c b/pp.c
index 860db37..3b55e66 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -493,7 +493,7 @@ PP(pp_prototype)
        const char * s = SvPVX_const(TOPs);
        if (strnEQ(s, "CORE::", 6)) {
            const int code = keyword(s + 6, SvCUR(TOPs) - 6, 1);
-           if (!code || code == -KEY_CORE)
+           if (!code)
                DIE(aTHX_ "Can't find an opnumber for \"%"UTF8f"\"",
                   UTF8fARG(SvFLAGS(TOPs) & SVf_UTF8, SvCUR(TOPs)-6, s+6));
            {
@@ -616,9 +616,19 @@ PP(pp_bless)
        const char *ptr;
 
        if (!ssv) goto curstash;
-       if (!SvGMAGICAL(ssv) && !SvAMAGIC(ssv) && SvROK(ssv))
+       SvGETMAGIC(ssv);
+       if (SvROK(ssv)) {
+         if (!SvAMAGIC(ssv)) {
+          frog:
            Perl_croak(aTHX_ "Attempt to bless into a reference");
-       ptr = SvPV_const(ssv,len);
+         }
+         /* SvAMAGIC is on here, but it only means potentially overloaded,
+            so after stringification: */
+         ptr = SvPV_nomg_const(ssv,len);
+         /* We need to check the flag again: */
+         if (!SvAMAGIC(ssv)) goto frog;
+       }
+       else ptr = SvPV_nomg_const(ssv,len);
        if (len == 0)
            Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
                           "Explicit blessing to '' (assuming package main)");
@@ -1017,7 +1027,9 @@ PP(pp_undef)
            gp_free(MUTABLE_GV(sv));
            Newxz(gp, 1, GP);
            GvGP_set(sv, gp_ref(gp));
+#ifndef PERL_DONT_CREATE_GVSV
            GvSV(sv) = newSV(0);
+#endif
            GvLINE(sv) = CopLINE(PL_curcop);
            GvEGV(sv) = MUTABLE_GV(sv);
            GvMULTI_on(sv);
@@ -1480,7 +1492,7 @@ PP(pp_divide)
 #if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
        if (! Perl_isnan(right) && right == 0.0)
 #else
-       if (right == 0.0)
+       if (NV_eq_nowarn(right, 0.0))
 #endif
            DIE(aTHX_ "Illegal division by zero");
        PUSHn( left / right );
@@ -1580,11 +1592,11 @@ PP(pp_modulo)
        if (use_double) {
            NV dans;
 
-           if (!dright)
+           if (NV_eq_nowarn(dright, 0.0))
                DIE(aTHX_ "Illegal modulus zero");
 
            dans = Perl_fmod(dleft, dright);
-           if ((left_neg != right_neg) && dans)
+           if ((left_neg != right_neg) && NV_ne_nowarn(dans, 0.0))
                dans = dright - dans;
            if (right_neg)
                dans = -dans;
@@ -2060,7 +2072,7 @@ Perl_do_ncmp(pTHX_ SV* const left, SV * const right)
        return -1;
       if (lnv > rnv)
        return 1;
-      if (lnv == rnv)
+      if (NV_eq_nowarn(lnv, rnv))
        return 0;
       return 2;
 #endif
@@ -2712,10 +2724,6 @@ PP(pp_sin)
    --Jarkko Hietaniemi 27 September 1998
  */
 
-#ifndef HAS_DRAND48_PROTO
-extern double drand48 (void);
-#endif
-
 PP(pp_rand)
 {
     dVAR;
@@ -2738,7 +2746,7 @@ PP(pp_rand)
                value = SvNV(sv);
        }
     /* 1 of 2 things can be carried through SvNV, SP or TARG, SP was carried */
-       if (value == 0.0)
+       if (NV_eq_nowarn(value, 0.0))
            value = 1.0;
        {
            dTARGET;
@@ -4354,6 +4362,51 @@ PP(pp_aslice)
     RETURN;
 }
 
+PP(pp_kvaslice)
+{
+    dVAR; dSP; dMARK;
+    AV *const av = MUTABLE_AV(POPs);
+    I32 lval = (PL_op->op_flags & OPf_MOD);
+    SSize_t items = SP - MARK;
+
+    if (PL_op->op_private & OPpMAYBE_LVSUB) {
+       const I32 flags = is_lvalue_sub();
+       if (flags) {
+           if (!(flags & OPpENTERSUB_INARGS))
+               /* diag_listed_as: Can't modify %s in %s */
+              Perl_croak(aTHX_ "Can't modify index/value array slice in list assignment");
+          lval = flags;
+       }
+    }
+
+    MEXTEND(SP,items);
+    while (items > 1) {
+       *(MARK+items*2-1) = *(MARK+items);
+       items--;
+    }
+    items = SP-MARK;
+    SP += items;
+
+    while (++MARK <= SP) {
+        SV **svp;
+
+       svp = av_fetch(av, SvIV(*MARK), lval);
+        if (lval) {
+            if (!svp || !*svp || *svp == &PL_sv_undef) {
+                DIE(aTHX_ PL_no_aelem, SvIV(*MARK));
+            }
+           *MARK = sv_mortalcopy(*MARK);
+        }
+       *++MARK = svp ? *svp : &PL_sv_undef;
+    }
+    if (GIMME != G_ARRAY) {
+       MARK = SP - items*2;
+       *++MARK = items > 0 ? *SP : &PL_sv_undef;
+       SP = MARK;
+    }
+    RETURN;
+}
+
 /* Smart dereferencing for keys, values and each */
 PP(pp_rkeys)
 {
@@ -4757,6 +4810,55 @@ PP(pp_hslice)
     RETURN;
 }
 
+PP(pp_kvhslice)
+{
+    dVAR; dSP; dMARK;
+    HV * const hv = MUTABLE_HV(POPs);
+    I32 lval = (PL_op->op_flags & OPf_MOD);
+    SSize_t items = SP - MARK;
+
+    if (PL_op->op_private & OPpMAYBE_LVSUB) {
+       const I32 flags = is_lvalue_sub();
+       if (flags) {
+           if (!(flags & OPpENTERSUB_INARGS))
+               /* diag_listed_as: Can't modify %s in %s */
+              Perl_croak(aTHX_ "Can't modify key/value hash slice in list assignment");
+          lval = flags;
+       }
+    }
+
+    MEXTEND(SP,items);
+    while (items > 1) {
+       *(MARK+items*2-1) = *(MARK+items);
+       items--;
+    }
+    items = SP-MARK;
+    SP += items;
+
+    while (++MARK <= SP) {
+        SV * const keysv = *MARK;
+        SV **svp;
+        HE *he;
+
+        he = hv_fetch_ent(hv, keysv, lval, 0);
+        svp = he ? &HeVAL(he) : NULL;
+
+        if (lval) {
+            if (!svp || !*svp || *svp == &PL_sv_undef) {
+                DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv));
+            }
+           *MARK = sv_mortalcopy(*MARK);
+        }
+        *++MARK = svp && *svp ? *svp : &PL_sv_undef;
+    }
+    if (GIMME != G_ARRAY) {
+       MARK = SP - items*2;
+       *++MARK = items > 0 ? *SP : &PL_sv_undef;
+       SP = MARK;
+    }
+    RETURN;
+}
+
 /* List operators. */
 
 PP(pp_list)
@@ -5892,7 +5994,7 @@ PP(pp_coreargs)
                const bool constr = PL_op->op_private & whicharg;
                PUSHs(S_rv2gv(aTHX_
                    svp && *svp ? *svp : &PL_sv_undef,
-                   constr, CopHINTS_get(PL_curcop) & HINT_STRICT_REFS,
+                   constr, cBOOL(CopHINTS_get(PL_curcop) & HINT_STRICT_REFS),
                    !constr
                ));
            }