The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!perl
use Test::More tests => 62;

use strict;
use warnings;
use utf8;

use JSPL;

my $rt1 = JSPL::Runtime->new();
my $okvis;
{
my $cx1 = $rt1->create_context();

$cx1->bind_all(
    ok => \&ok,
    is => \&is,
    is_deeply => \&is_deeply,
    check => sub { 
	my $ref = shift;
	isa_ok($ref, 'HASH');
	isa_ok(JSPL::Context::current->jsvisitor($ref), 'JSPL::Visitor',
	    "Now a visitor");
    }, 
);

my $str = "x" x 40000;
$cx1->eval(<<"END_OF_CODE");

function test_undefined(v1) {
    ok(v1 == undefined, "Undefined");
}

/*
    Not really void but we need to know what happens
    when we call a function that expects arguments
    but we fail to provide any
*/
function test_void(v1) {
    ok(v1 == undefined, "undefined");
}


function test_int(v1, v2, v3, v4) {
    ok(v1 == -1, "Negative integers");
    ok(v2 == 0, "Zero integers");
    ok(v3 == 1, "Positive integers");
    ok(v4 == 5000000000, "Really big integers");
}

function test_float(v1, v2, v3, v4) {
    ok(v1 == -1.1, "Negative doubles");
    ok(v2 == 0.0, "Zero doubles");
    ok(v3 == 1.1, "Positive doubles");
    ok(v4 == 5000000000.5, "Really big doubles");
}

function test_string(v1, v2, v3) {
    ok(v1 == "", "Empty string");
    ok(v2 == "foobar", "Short string");
    ok(v3 == "$str", "Long string > 32768 chars");
}

function test_array(v1, v2, v3) {
    ok(v1.length == 0 &&
       v1.toString() == "", "Empty array");
    ok(v2.length == 3 &&
       v2.toString() == "3,2,1", "Array is " + v2.toString());
    
    scratch = "";
    for (x in v2) scratch += x;
    is(scratch, '012', "Indexes are in the right order ("+ scratch + ")" );

    ok(v2 instanceof PerlArray, "Instance of PerlArray");
    is(v2.indexOf(1), 2, "indexOf");

    v2.reverse();
    is(v2.toString(), "1,2,3", "Reverse");
    is(v2.join(":"), "1:2:3", "Joined is "+v2.join(":"));
    is_deeply(v2.slice(), [1, 2, 3], "slice");

    is(v3+"", "Blue,Zebra,Hump,Beluga", "Strings");
    is(v3.sort()+"", "Beluga,Blue,Hump,Zebra", "Sorted");
    is(v3.toSource(), "new PerlArray('Beluga','Blue','Hump','Zebra')", v3.toSource());
}

function test_hash(v1, v2) {
    var i = 0;
    for (var p in v1) {
        i++;
    }
    ok(i == 0, "Empty hash");

    i = 0;
    for (var p in v2) {
        if (p == "a" && v2[p] == 1) i++;
        if (p == "b" && v2[p] == 2) i++;
    }
    ok(i == 2, "Hash");
    ok(v2.toString(), '[object PerlHash]');
    ok(v2.toSource(), "new PerlHash('a',1,'b',2)");

    check(v2);
    
    ok(v2 instanceof PerlHash, "Instance of PerlHash");
}

function test_complex(v1) {
    var i = 0;
    for (var p in v1) {
        if (p == "a" && v1[p].toString() == "1,2,3") i++;
        if (p == "b") {
            var j = 0;
            for (var q in v1[p]) {
                if (q == "c" && v1[p][q] == 1) j++;
            }
            if (j == 1) {
                i++;
            }
        }
    }
    ok(i == 2, "Complex ok");
    ok(v1.toSource(), v1.toSource());
}

function test_function(v1, type) {
    ok(v1 instanceof PerlSub, "Instance of PerlSub");
    is(typeof v1, type);
    v1();
}

function test_other(v1, v2) {
    ok(true, "In test_other");
    ok(v1 instanceof PerlScalar, "Instance of PerlScalar");
    ok(v2 instanceof PerlScalar, "Instance of PerlScalar");
    is(v2.valueOf(), 1000, "A number");
    ok(v2+"" == "1000", "To string" );
    ok(v2 == 1000, "Automatic");
    var val = v1.valueOf();
    is(val, "string", "A simple string");
    ok(v1+"" == "string", "Automatic string");
}
END_OF_CODE

$cx1->call(test_undefined => undef);
$cx1->call("test_void");
$cx1->call(test_int => -1, 0, 1, 5_000_000_000);
$cx1->call(test_float => -1.1, 0.0, 1.1, 5000000000.5);
$cx1->call(test_string => "", "foobar", $str);
my $arr = [ qw(Blue Zebra Hump Beluga) ];
$cx1->call(test_array => [], [3, 2, 1], $arr);
is($arr->[0], 'Beluga', "Propagated");

{
    my $h = {};
    my $h2 = { a => 1, 'b' => 2 };
    ok(!JSPL::jsvisitor($h2), "Not a visitor yet");
    $cx1->call(test_hash => $h, $h2);
    ok(!JSPL::jsvisitor($h2), "Was a visitor");
    $h = undef;
    $h2 = undef;
}

$cx1->call(test_complex => { a => [1, 2, 3], b => { c => 1 } });
$cx1->call(test_function => sub { ok(1,"test function"); },
    JSPL::get_internal_version >= 185 
	? 'function' # Finally fixed
	: 'object'
);
$cx1->call(test_other => \"string", \1000);
{
    my $string = "string";
    my $number = 1000;
    $cx1->call(test_other => \($string, $number));
}

# Test a little more jsvisitor machinery
is(JSPL::jsvisitor(\&ok), $cx1->id, 'ok is a visitor');
ok(($okvis = $cx1->jsvisitor(\&ok)), "Can get its wrapper");
isa_ok($okvis, 'JSPL::Visitor');
ok($okvis->VALID, "Is valid");
}
ok(!JSPL::jsvisitor(\&ok), "But not now");
ok(!$okvis->VALID, "Visitor invalidated\n");

ok(1, "All done");