#!perl
use Test::More tests => 33;
use strict;
use warnings;
use Test::Exception;
use JSPL;
my $rt1 = JSPL::Runtime->new();
{
my $cx1 = $rt1->create_context();
$cx1->eval(q[
function multiply(a, b) {
return a * b;
}
multiply.attr = 'hi';
]);
is($cx1->call("multiply", 2, 3), 6, 'Called javascript function via name');
throws_ok {
$cx1->call("divide", 6, 2)
} qr/Undefined subroutine divide/, "Called non-existing function and got exception";
my $func = $cx1->eval(q{
/* Return a javascript function object */
multiply;
});
isa_ok($func, "JSPL::Function");
isa_ok($func, "JSPL::Object", "Also");
is($cx1->call($func, 4, 3), 12, 'Call via JSPL::Function object via $context->call');
is($func->(4, 5), 20, "Call via JSPL::Function object direct invocation");
is($func->call(undef, 6, 3), 18, 'Call via call method');
is($func->apply(undef, [7, 4]), 28, "Called via apply method");
is($func->{attr}, 'hi', "Has properties");
{
ok(my $obj = \%{$func},"Can get it as an object");
isa_ok($obj, 'HASH');
isa_ok(tied(%$obj),"JSPL::Function");
is(ref($func),ref(tied %$obj), "Same reference");
is($obj->{attr}, 'hi', "Object usable");
is($obj->{name}, 'multiply', "My name is 'multiply'");
is($obj->{'length'}, 2, "Expect two arguments");
ok(my $proto = $func->prototype, "Has a prototype");
isa_ok($proto, 'JSPL::Object', "The proto");
{
local $cx1->{AutoTie} = 0;
is($proto, $obj->{'prototype'}, "proto is here too");
}
#only one reference
}
is($func->{constructor}, $cx1->get_global->{'Function'}, "Is a function");
is($func->{constructor}{name}, 'Function', " as expected");
is($func->{__proto__}, $func->{constructor}{'prototype'}, " has a __proto__");
ok($func->toString(), "As string is '".$func->toString()."'");
ok($func->toSource(), "Source is '". $func->toSource(). "'");
$cx1->get_global->{'mult'} = $func;
is($cx1->eval(q{ typeof mult }), 'function', "Can create a clone");
is($cx1->call(mult => 2, 3), 6, "Clone called");
$cx1->get_global->{'mult'} = undef;
is($cx1->eval(q{ typeof mult }), 'undefined', "Clone gone");
throws_ok {
$cx1->call(mult => 2, 3);
} qr/Undefined subroutine mult/, "Can't be called";
{
# Make sure functions aren't shared between contexts
my $cx2 = $rt1->create_context();
throws_ok {
$cx2->call("multiply", 2, 3);
} qr/Undefined subroutine multiply/, "Functions are context-bound";
}
$cx1->get_global->{'multiply'} = undef;
throws_ok { $cx1->call(multiply => 2, 3); } qr/Undefined/, "Deleted";
$cx1->get_global->{'multiply'} = $func;
is($cx1->call(multiply => 2, 3), 6, "Reinstalled");
undef $func;
is($cx1->call(multiply => 2, 3), 6, "Alive");
}
ok(1, "All done, clean");