# 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")