File: multidimensional.xs

package info (click to toggle)
libmultidimensional-perl 0.010-1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd, wheezy
  • size: 140 kB
  • ctags: 8
  • sloc: perl: 91; makefile: 2
file content (58 lines) | stat: -rw-r--r-- 1,491 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "hook_op_check.h"

#ifndef PERL_UNUSED_ARG
# define PERL_UNUSED_ARG(x) PERL_UNUSED_VAR(x)
#endif /* !PERL_UNUSED_ARG */

#ifndef hv_fetchs
# define hv_fetchs(hv, key, lval) hv_fetch(hv, key, strlen(key), lval)
#endif /* !hv_fetchs */

STATIC OP *last_list_start;

STATIC OP *multidimensional_list_check_op (pTHX_ OP *op, void *user_data) {
    PERL_UNUSED_ARG(user_data);

    last_list_start = ((LISTOP*)op)->op_first->op_sibling;

    return op;
}

STATIC OP *multidimensional_helem_check_op (pTHX_ OP *op, void *user_data) {
    SV **hint = hv_fetchs(GvHV(PL_hintgv), "multidimensional", 0);
    const OP *last;

    PERL_UNUSED_ARG(user_data);

    if (!hint || !SvOK(*hint))
	return op;

    last = ((BINOP*)op)->op_first->op_sibling;
    if (last && last->op_type == OP_JOIN) {
	const OP *first = ((LISTOP*)last)->op_first;
	const OP *next = first->op_sibling;
	if (first && first->op_type == OP_PUSHMARK
	    && next && next->op_type == OP_RV2SV
	    && next != last_list_start
	) {
	    const OP *child = ((UNOP*)next)->op_first;
	    if (child->op_type == OP_GV
		&& GvSV(cGVOPx_gv(child)) == get_sv(";", 0)
	    ) {
		croak("Use of multidimensional array emulation");
	    }
	}
    }
    return op;
}

MODULE = multidimensional PACKAGE = multidimensional

PROTOTYPES: ENABLE

BOOT:
    hook_op_check(OP_HELEM, multidimensional_helem_check_op, NULL);
    hook_op_check(OP_LIST, multidimensional_list_check_op, NULL);