view release on metacpan or  search on metacpan

opcode.c  view on Meta::CPAN

/* Selected functions borrowed from perl's ext/Opcode/Opcode.xs */

/* PL_maxo shouldn't differ from MAXO but leave room anyway (see BOOT:)	*/
#define OP_MASK_BUF_SIZE (MAXO + 100)
#define opset_len   ((PL_maxo + 7) / 8)

static void
opmask_add(pTHX_ char *bitmask, STRLEN len)
{
    int i,j;
    int myopcode = 0;

    if (len != opset_len)
	croak("Invalid opset: wrong size");

    if (!PL_op_mask)		/* caller must ensure PL_op_mask exists	*/
	croak("Can't add to uninitialised PL_op_mask");

    /* OPCODES ALREADY MASKED ARE NEVER UNMASKED. See opmask_addlocal()	*/

    for (i=0; i < opset_len; i++) {
	U16 bits = bitmask[i];
	if (!bits) {	/* optimise for sparse masks */
	    myopcode += 8;
	    continue;
	}
	for (j=0; j < 8 && myopcode < PL_maxo; )
	    PL_op_mask[myopcode++] |= bits & (1 << j++);
    }
}

t/safecall.py  view on Meta::CPAN

    eval $code;
    die if $@;
}

sub foo { 42; }

*Safe1::_compile = \&compile;
""")

mask = perl.call("Opcode::opset", "bless", "add")
#print perl.call_tuple("Opcode::opset_to_ops", mask)

perl.safecall("Safe1", mask, ('_compile', 'my $n = shift; print "ok $n\\n";'))
perl.safecall("Safe1", mask, ('do', 1))

# try a trapped opcode
try:
    perl.safecall("Safe1", mask, ('_compile', 'return bless {}, "Foo"'))
except perl.PerlError as v:
    #print v
    if not re.match('^\'bless\' trapped by operation mask', str(v)): print("not ", end=' ')