#!./perl

BEGIN { require './test.pl'; }
BEGIN { plan( tests => 14 ); }

use warnings;

use compsub;

# create a user defined functions.
# basic test that is called the correct number of times.

our $foo_called;
# BEGIN {
#     # define 'function' foo, which only executes it first argument.
#     # i.e. the opcode tree generated by foo $arg1, $arg2, ...  is something like as $arg1, $arg2, ...
#     $^H{'compsub'} = {
#                         foo => sub { $foo_called++; return @_[0] },
#                        };
# }
BEGIN { compsub::define( foo => sub { $foo_called++; @_[0] or die "no arguments"; return @_[0] } ); }

BEGIN { is $foo_called, undef; }
sub bar { foo(); }
BEGIN { is $foo_called, 1; }

is( (join '*', @(foo 1, 2)), "1*2");

BEGIN { is $foo_called, 2; }

use B ();
use B::OP ();

# fst $arg1, $arg2, ... evaluates only its first argument
# this leaks the OP_LIST, and the remaining items in the listop
BEGIN { compsub::define( fst => sub { my $first = @_[0]->first->sibling;
                                        # remove $first from the list of children of @_[0]
                                        @_[0]->first->set_sibling($first->sibling);
                                        @_[0]->free; undef @_[0];
                                        # free the @_[0] opcode.
                                        return $first;
                                    }
                         );
    }

$b = "oldb";
fst(($a="newa"), ($b="notset"));
is("$a-$b", "newa-oldb");

do {
    BEGIN { compsub::define( nothing => sub { @_[?0] and @_[0]->free; return B::OP->new('null', 0, @("myop", 33, 66)) } ); }
    nothing;

    eval "nothing";
    ok ! $^EVAL_ERROR, "compsub in run-time eval";
};
eval "nothing";
like $^EVAL_ERROR->{description}, qr/Bareword "nothing" not allowed/, "compsub lexical scoped.";


## calling a function
do {
    our $x;
    sub func1 { $x++; return "func1 called. args: $(join ' ', @_)" };

    BEGIN { compsub::define( compfunc1 => 
                               sub { my $op = shift;
                                     my $cvop = B::SVOP->new('const', 0, \&func1, @('myop', 1, 1));
                                     $op = B::LISTOP->new('list', 0, ($op ?? ($op, $cvop) !! ($cvop, undef)), @());
                                     return B::UNOP->new('entersub', B::OPf_STACKED^|^B::OPf_SPECIAL, $op, @('compfunc1'));
                                 } ); }

    is( (compfunc1), "func1 called. args: ");
    is( (compfunc1 1, 2, 3), "func1 called. args: 1 2 3");
    is( (compfunc1 1, 2, 3), "func1 called. args: 1 2 3");
    is( (compfunc1(1, 2, 3)), "func1 called. args: 1 2 3");
    is( (compfunc1(1, 2), 3), "func1 called. args: 1 2 3");
};

## parsing params, and declaring lexical variables.
do {
    # assumes argument like: 'foo' => \$foo, 'bar' => \$bar, { @_ }
    sub parseparams {
        my $values = pop @_;
        while (my $name = shift @_) {
            @_[0] = $values->{$name};
            shift @_;
        }
    }

    # assumes argument like C<'foo', 'bar', { @_ }>
    # this will be converted like C<parseparams('foo', \(my $foo), 'bar', \(my $bar), { @_ })>
    sub compparams {
        my $op = shift;
        $op or return B::UNOP->new('null', 0);
        my $kid = $op->first;
        while (ref $kid ne "B::NULL") {
            if ($kid->name eq "const") {
                # allocate a 'my' variable
                my $targ = B::PAD::allocmy( '$' . ${ $kid->sv->object_2svref } );
                # introduce the 'my' variable, and insert it into the list of argument.
                my $padsv = B::OP->new('padsv', B::OPf_MOD, undef);
                $padsv->set_private(B::OPpLVAL_INTRO);
                $padsv->set_targ($targ);
                $padsv->set_sibling($kid->sibling);
                $kid->set_sibling($padsv);

                $kid = $padsv;
            } elsif ($kid->name eq "list" or $kid->name eq "pushmark") {
                # ignore
            } elsif ($kid->name eq "srefgen") {
                # ignore, assume it is the last item in the list.
            } else {
                die "Expected constant opcode but got " . $kid->name;
            }
            $kid = $kid->sibling;
        }
        my $cvop = B::SVOP->new('const', 0, \&parseparams, undef);
        $op = B::LISTOP->new('list', 0,
                             ($op ?? ($op, $cvop) !! ($cvop, undef)), undef);
        my $entersubop = B::UNOP->new('entersub', B::OPf_STACKED^|^B::OPf_SPECIAL, $op, undef);
        return $entersubop;
    }

    BEGIN {
        compsub::define( params => \&compparams )
    }

    do {
        sub foobar {
            params 'foo', 'bar', \%( < @_ );
            is $foo, 'foo-value', '$foo declared and initialized';
            is $bar, 'bar-value';
        }

        foobar( foo => "foo-value", bar => "bar-value" );
    };
};