Also fix wince for caretx after e2051532106.

[perl5.git] / pp.c

diff --git a/pp.c b/pp.c
index 860db37..d090069 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -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);
@@ -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;
@@ -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
                ));
            }