The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!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");