key/value hash slice operation

[perl5.git] / pp.c

diff --git a/pp.c b/pp.c
index 5e0b02c..470ebd1 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -4753,6 +4753,54 @@ PP(pp_hslice)
     RETURN;
 }
 
+PP(pp_kvhslice)
+{
+    dVAR; dSP; dMARK; dORIGMARK;
+    HV * const hv = MUTABLE_HV(POPs);
+    I32 lval = (PL_op->op_flags & OPf_MOD);
+    I32 items = SP - MARK;
+
+    if (PL_op->op_private & OPpMAYBE_LVSUB) {
+       const I32 flags = is_lvalue_sub();
+       if (flags) {
+           if (!(flags & OPpENTERSUB_INARGS))
+              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)