File Coverage

FirstMultideref.xsh
Criterion Covered Total %
statement 15 22 68.1
branch 3 6 50.0
condition n/a
subroutine n/a
pod n/a
total 18 28 64.2


line stmt bran cond sub pod time code
1             =begin comment
2             // NOTE: first_multideref_type
3             /*
4             * first_multideref_type - Determines the reference type (ARRAY or HASH) for an
5             * OP_MULTIDEREF operation.
6             *
7             * Perl Version: Requires Perl v5.22.0 or later.
8             * OP_MULTIDEREF was introduced in Perl 5.22.
9             *
10             * Arguments:
11             * I32 uplevel
12             * How many levels up the call stack to examine the op tree.
13             *
14             * Return:
15             * A mortalised Perl scalar (SV*) containing a string:
16             * - "ARRAY" if the multideref op resolves to an array dereference
17             * - "HASH" if it resolves to a hash dereference
18             *
19             * Throws a fatal exception if:
20             * - The op at the given uplevel is not of type OP_MULTIDEREF
21             * - The OP_MULTIDEREF action is unrecognised
22             * - Called on a Perl version earlier than v5.22.0
23             *
24             * Usage Example in Perl (via XS binding):
25             *
26             * if( $ref_type = Wanted::first_multideref_type(1) )
27             * {
28             * say "Reference type: $ref_type"; # ARRAY or HASH
29             * }
30             *
31             * Notes:
32             * - This is used internally by the `wantref()` and `context()` functions to determine
33             * whether the user expects an ARRAY or HASH reference in contexts using Perl's
34             * optimised multideref op.
35             *
36             * - Because OP_MULTIDEREF is a compound op containing a sequence of deref actions
37             * (stored in 'op_aux'), this function inspects the action sequence and identifies
38             * the first relevant dereference type.
39             *
40             * - If MDEREF_reload is encountered, it advances to the next action.
41             * This loop ensures it finds the actual dereference operation.
42             *
43             * - Not intended for external use. If exposed, the XS wrapper should sanitise input and
44             * protect against unsupported contexts.
45             *
46             * Related:
47             * See perldiag: https://perldoc.perl.org/5.22.0/perl5220delta#Internal-Changes
48             * See MDEREF_* constants in perl.h / op.h for more info.
49             */
50             =cut
51             #if PERL_VERSION_GE(5, 22, 0)
52              
53             char*
54             first_multideref_type(uplevel)
55             I32 uplevel;
56             PREINIT:
57             OP *r;
58 7           OP *o = parent_op(uplevel, &r);
59             UNOP_AUX_item *items;
60             UV actions;
61             bool repeat;
62             char *retval;
63             PPCODE:
64 7 50         if (o->op_type != OP_MULTIDEREF)
65 0           Perl_croak(aTHX_ "Not a multideref op!");
66              
67 7           items = cUNOP_AUXx(o)->op_aux;
68 7           actions = items->uv;
69              
70             do
71             {
72 7           repeat = FALSE;
73 7           switch (actions & MDEREF_ACTION_MASK)
74             {
75 0           case MDEREF_reload:
76 0           actions = (++items)->uv;
77 0           repeat = TRUE;
78 0           continue;
79 4           case MDEREF_AV_pop_rv2av_aelem:
80             case MDEREF_AV_gvsv_vivify_rv2av_aelem:
81             case MDEREF_AV_padsv_vivify_rv2av_aelem:
82             case MDEREF_AV_vivify_rv2av_aelem:
83             case MDEREF_AV_padav_aelem:
84             case MDEREF_AV_gvav_aelem:
85 4           retval = "ARRAY";
86 4           break;
87 3           case MDEREF_HV_pop_rv2hv_helem:
88             case MDEREF_HV_gvsv_vivify_rv2hv_helem:
89             case MDEREF_HV_padsv_vivify_rv2hv_helem:
90             case MDEREF_HV_vivify_rv2hv_helem:
91             case MDEREF_HV_padhv_helem:
92             case MDEREF_HV_gvhv_helem:
93 3           retval = "HASH";
94 3           break;
95 0           default:
96 0           Perl_croak(aTHX_ "Unrecognised OP_MULTIDEREF action (%lu)!", actions & MDEREF_ACTION_MASK);
97             }
98 7 50         } while (repeat);
99              
100 7 50         EXTEND(SP, 1);
101 7           PUSHs(sv_2mortal(newSVpv(retval, 0)));
102              
103             #else
104              
105             char*
106             first_multideref_type(uplevel)
107             I32 uplevel;
108             PPCODE:
109             Perl_croak(aTHX_ "first_multideref_type is not supported on this Perl version");
110              
111             #endif