1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4 #include "hook_op_check.h"
5 #include "ppport.h"
6
7 STATIC OP *last_list_start;
8
multidimensional_list_check_op(pTHX_ OP * op,void * user_data)9 STATIC OP *multidimensional_list_check_op (pTHX_ OP *op, void *user_data) {
10 PERL_UNUSED_ARG(user_data);
11
12 last_list_start = OpSIBLING(((LISTOP*)op)->op_first);
13
14 return op;
15 }
16
multidimensional_helem_check_op(pTHX_ OP * op,void * user_data)17 STATIC OP *multidimensional_helem_check_op (pTHX_ OP *op, void *user_data) {
18 SV **hint = hv_fetchs(GvHV(PL_hintgv), "multidimensional/disabled", 0);
19 const OP *last;
20
21 PERL_UNUSED_ARG(user_data);
22
23 if (!hint || !SvOK(*hint))
24 return op;
25
26 last = OpSIBLING(((BINOP*)op)->op_first);
27 if (last && last->op_type == OP_JOIN) {
28 const OP *first = ((LISTOP*)last)->op_first;
29 const OP *next = OpSIBLING(first);
30 if (first && first->op_type == OP_PUSHMARK
31 && next && next->op_type == OP_RV2SV
32 && next != last_list_start
33 ) {
34 const OP *child = ((UNOP*)next)->op_first;
35 if (child->op_type == OP_GV
36 && GvSV(cGVOPx_gv(child)) == get_sv(";", 0)
37 ) {
38 croak("Use of multidimensional array emulation");
39 }
40 }
41 }
42 return op;
43 }
44
45 MODULE = multidimensional PACKAGE = multidimensional
46
47 PROTOTYPES: ENABLE
48
49 BOOT:
50 hook_op_check(OP_HELEM, multidimensional_helem_check_op, NULL);
51 hook_op_check(OP_LIST, multidimensional_list_check_op, NULL);
52