Add support for the new OP_MULTIDEREF

Perl has a new op, added as a performance optimisation in fedf30e1c349130b23648c022f5f3cb4ad7928f3,
to represent a sequence of array/hash dereferences. This patch adds support for the new op.

Author: robinhouston

Changes

@@ -119,3 +119,8 @@ Revision history for Perl extension Want.
 0.24  Tue  2 Dec 2014 10:22:39 GMT
     - Accommodate another bleadperl change. Patch provided by Father Chrysostomos at
       https://rt.cpan.org/Public/Bug/Display.html?id=100626
+
+0.25  Wed 10 Dec 2014 19:31:03 GMT
+    - Add support for the new OP_MULTIDEREF
+      Perl has a new op, added as a performance optimisation in fedf30e1c349130b23648c022f5f3cb4ad7928f3,
+      to represent a sequence of array/hash dereferences. This patch adds support for the new op.

README

@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
-| Want v0.24    - Robin Houston, 2014-12-02
+| Want v0.25    - Robin Houston, 2014-12-10
 -----------------------------------------------------------------------------
 
 For full documentation, see the POD included with the module.

Want.pm

@@ -12,7 +12,7 @@ our @ISA = qw(Exporter DynaLoader);
 
 our @EXPORT = qw(want rreturn lnoreturn);
 our @EXPORT_OK = qw(howmany wantref);
-our $VERSION = '0.24';
+our $VERSION = '0.25';
 
 bootstrap Want $VERSION;
 
@@ -128,7 +128,8 @@ sub howmany () {
 }
 
 sub wantref {
-    my $n = parent_op_name(bump_level(@_, 1));
+    my $level = bump_level(@_, 1);
+    my $n = parent_op_name($level);
     if    ($n eq 'rv2av') {
 	return "ARRAY";
     }
@@ -147,6 +148,9 @@ sub wantref {
     elsif ($n eq 'method_call') {
 	return 'OBJECT';
     }
+    elsif ($n eq 'multideref') {
+	return first_multideref_type($level);
+    }
     else {
 	return "";
     }

Want.xs

@@ -543,6 +543,57 @@ I32 uplevel;
 	PUSHs(sv_2mortal(newSVpv(retval, 0)));
     }
 
+#ifdef OPpMULTIDEREF_EXISTS
+char*
+first_multideref_type(uplevel)
+I32 uplevel;
+  PREINIT:
+    OP *r;
+    OP *o = parent_op(uplevel, &r);
+    UNOP_AUX_item *items;
+    UV actions;
+    bool repeat;
+    char *retval;
+  PPCODE:
+    if (o->op_type != OP_MULTIDEREF) Perl_croak(aTHX_ "Not a multideref op!");
+    items = cUNOP_AUXx(o)->op_aux;
+    actions = items->uv;
+
+    do {
+	repeat = FALSE;
+	switch (actions & MDEREF_ACTION_MASK) {
+	    case MDEREF_reload:
+		actions = (++items)->uv;
+		repeat = TRUE;
+		continue;
+
+	    case MDEREF_AV_pop_rv2av_aelem:
+	    case MDEREF_AV_gvsv_vivify_rv2av_aelem:
+	    case MDEREF_AV_padsv_vivify_rv2av_aelem:
+	    case MDEREF_AV_vivify_rv2av_aelem:
+	    case MDEREF_AV_padav_aelem:
+	    case MDEREF_AV_gvav_aelem:
+		retval = "ARRAY";
+		break;
+
+	    case MDEREF_HV_pop_rv2hv_helem:
+	    case MDEREF_HV_gvsv_vivify_rv2hv_helem:
+	    case MDEREF_HV_padsv_vivify_rv2hv_helem:
+	    case MDEREF_HV_vivify_rv2hv_helem:
+	    case MDEREF_HV_padhv_helem:
+	    case MDEREF_HV_gvhv_helem:
+		retval = "HASH";
+		break;
+
+	    default:
+		Perl_croak(aTHX_ "Unrecognised OP_MULTIDEREF action (%lu)!", actions & MDEREF_ACTION_MASK);
+	}
+    } while (repeat);
+
+    EXTEND(SP, 1);
+    PUSHs(sv_2mortal(newSVpv(retval, 0)));
+
+#endif
 
 I32
 want_count(uplevel)