The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use Test::More skip_all => $^V lt v5.10;
use Data::Dumper;
use JavaScript::V8;

use utf8;
use strict;
use warnings;

my $context = JavaScript::V8::Context->new();

$context->bind( 
    warn => sub { warn(@_) },
);

$context->bind(
    dump => sub { warn Dumper $_[0] },
);

package Counter;

sub new {
    my $class = shift;
    bless { val => 1 }, $class;
}

sub inc {
    my $self = shift;
    $self->{val}++
}

sub get {
    my $self = shift;
    $self->{val}
}

sub set {
    my ($self, $new) = @_;
    $self->{val} = $new;
}

sub copy_from {
    my ($self, $other_counter) = @_;
    $self->set($other_counter->get);
}

sub error {
    die 'SomePerlError';
}

sub DESTROY {
    my $self = shift;
    ($self->{on_destroy} || sub {})->();
}
    
package main;

$context->eval(<<'END');
function test1(counter1) {
    return counter1.get() == 1;
}
function test2(counter1, counter2) {
    counter1.copy_from(counter2);
    return counter1.get();
}
function testErrorWrapped(counter) {
    try {
        counter.error();
    }
    catch(e) {

    }
    return 222;
}
function testError(counter) {
    counter.error();
    return 111;
}
END

my $c1 = Counter->new;
my $c2 = Counter->new;

ok $context->eval('test1')->($c1);

$c1->set(8);
$c2->set(2);
is $context->eval('test2')->($c1, $c2), 2;

is $context->eval('(function(c) { return c })')->($c1), $c1;

my $res1 = eval { $context->eval('testError')->($c1) };
ok !$res1, 'error was not caught - no value returned';
like $@, qr{SomePerlError}, 'proper error message';

my $res2 = $context->eval('testErrorWrapped')->($c1);
is $res2, 222, 'error was caught and execution countinued gracefully';
ok !$@, 'no error message';

$context->set_flags_from_string("--expose-gc");
#$context->set_flags_from_string("--trace-gc");

{
    my $destroyed;
    {
        my $c = Counter->new;
        $c->set(42);
        $c->{on_destroy} = sub { $destroyed = 1 };
        $context->eval('(function(c) { C = c })')->($c);
    }
    1 while !$context->idle_notification;

    ok !$destroyed, 'global js object is kept alive when perl scope is done';
    is $context->eval('C')->get, 42, 'proper value is retained';
}

{
    my $destroyed;
    {
        my $c = Counter->new;
        $c->set(42);
        $c->{on_destroy} = sub { $destroyed = 1 };
        $context->eval('(function(c) { return c.get() + 1; })')->($c);
    }
    1 while !$context->idle_notification;

    ok $destroyed, 'local js object is destroyed after perl scope is done';
}
 
{
    my $c = Counter->new;
    $context->eval('(function (c) { c.zzz = "value to persist"; })')->($c);
    is $context->eval('(function (c) { return c.zzz; })')->($c), "value to persist", 'perl objects are converted once';
}

{
    my $c = sub { };
    $context->eval('(function (c) { c.zzz = "value to persist"; })')->($c);
    is $context->eval('(function (c) { return c.zzz; })')->($c), "value to persist", 'perl functions are converted once';
}

done_testing;