# try calling perl function in array and scalar context
# first define a function
perl.eval("""
sub foo2 {
wantarray ? (1, 2, 3) : 42;
}
""")
# scalar context
if perl.call("foo2") != 42: print "not",
print "ok 6"
# array context (tuple back)
res = perl.call_tuple("foo2")
if len(res) != 3 or res[0] != 1 or res[1] != 2 or res[2] != 3: print "not",
print "ok 7"
# can we call anonymous perl functions
# can we pass hashes both ways
if perl.MULTI_PERL:
print "actually skipping test 8..."
print "ok 8"
else:
func = perl.eval("sub { $_[0] + $_[1] }")
if int(func(3, 4)) != 7: print "not",
print "ok 8"
def test_function_array_context_tuple_back(self):
res = perl.call_tuple("foo2")
self.assertEqual(len(res), 3)
self.assertEqual(res[0], 1)
self.assertEqual(res[1], 2)
self.assertEqual(res[2], 3)
# This test that the embedded perl can load XS modules that happen
# to be (usually) separate dynamic libraries.
print("1..2")
import perl
addr = perl.eval("""
require Socket;
Socket::pack_sockaddr_in(80, Socket::inet_aton('127.0.0.1'));
""");
#print repr(addr);
if not addr: print("not ", end=' ')
print("ok 1");
addr = perl.call_tuple("Socket::unpack_sockaddr_in", addr)
#print addr
if addr[0] != 80 or len(addr[1]) != 4: print("not ", end=' ')
print("ok 2")
# This test that the embedded perl can load XS modules that happen
# to be (usually) separate dynamic libraries.
print "1..2"
import perl
addr = perl.eval("""
require Socket;
Socket::pack_sockaddr_in(80, Socket::inet_aton('127.0.0.1'));
""")
#print repr(addr);
if not addr: print "not ",
print "ok 1"
addr = perl.call_tuple("Socket::unpack_sockaddr_in", addr)
#print addr
if addr[0] != 80 or len(addr[1]) != 4: print "not ",
print "ok 2"
global testno
if res != expect:
print("Expected", repr(expect), "got", repr(res))
print("not", end=' ')
print("ok", testno)
testno = testno + 1
void = None
scalar = "scalar"
array = ("array", )
expect(foo(), scalar)
expect(foo(__wantarray__=1), array)
expect(foo(__wantarray__=None), void)
foo.__wantarray__ = 1
expect(foo(), array)
expect(foo(__wantarray__=0), scalar)
expect(foo(__wantarray__=None), void)
foo.__wantarray__ = None
expect(foo(), void)
expect(perl.call("foo"), scalar)
expect(perl.call_tuple("foo"), array)
expect(perl.call("foo", __wantarray__=1), array)
expect(perl.call_tuple("foo", __wantarray__=0), scalar)
def expect(res, expect):
global testno
if res != expect:
print "Expected", repr(expect), "got", repr(res)
print "not",
print "ok", testno
testno = testno + 1
void = None
scalar = "scalar"
array = ("array",)
expect(foo(), scalar)
expect(foo(__wantarray__ = 1), array)
expect(foo(__wantarray__ = None), void)
foo.__wantarray__ = 1;
expect(foo(), array)
expect(foo(__wantarray__ = 0), scalar)
expect(foo(__wantarray__ = None), void)
foo.__wantarray__ = None
expect(foo(), void)
expect(perl.call("foo"), scalar)
expect(perl.call_tuple("foo"), array)
expect(perl.call("foo", __wantarray__ = 1), array)
expect(perl.call_tuple("foo", __wantarray__ = 0), scalar)
my($code) = @_;
$code = "package main; sub do { " . $code . "}";
#print "[[$code]]\\n";
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, v:
#print v
if not re.match('^bless trapped by operation mask', str(v)): print "not ",
print "ok 2"
# The following call reset the perl parser state enought to
# avoid the 'nexttoke' bug.
perl.eval(""" sub ffff {}""")
print("ok 5")
# try calling perl function in array and scalar context
# first define a function
perl.eval("""
sub foo2 {
wantarray ? (1, 2, 3) : 42;
}
""")
# scalar context
if perl.call("foo2") != 42: print("not", end=' ')
print("ok 6")
# array context (tuple back)
res = perl.call_tuple("foo2")
if len(res) != 3 or res[0] != 1 or res[1] != 2 or res[2] != 3:
print("not", end=' ')
print("ok 7")
# can we call anonymous perl functions
# can we pass hashes both ways
if perl.MULTI_PERL:
print("actually skipping test 8...")
print("ok 8")
else:
func = perl.eval("sub { $_[0] + $_[1] }")
if int(func(3, 4)) != 7: print("not", end=' ')
print("ok 8")
my($code) = @_;
$code = "package main; sub do { " . $code . "}";
#print "[[$code]]\\n";
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, v:
#print v
if not re.match('^bless trapped by operation mask', str(v)): print "not ",
print "ok 2"
# The following call reset the perl parser state enought to
# avoid the 'nexttoke' bug.
perl.eval(""" sub ffff {}""")
def test_function_array_context_tuple_back(self):
res = perl.call_tuple("foo2")
self.assertEqual(len(res), 3)
self.assertEqual(res[0], 1)
self.assertEqual(res[1], 2)
self.assertEqual(res[2], 3)
