#! perl

use Test::Lib;
use Test2::V0;
use Test2::Tools::PDL;

use Scalar::Util qw[ refaddr ];

package Test {

    use Test2::V0;
    use Role::Tiny::With;
    use My::Test::Role;
    use PDL::Lite;

    with My::Test::Role::Single();

    sub test_obj {
        my $class = shift;

        $class->test_class_new(
            p1 => PDL->sequence( 5 ),
            p2 => PDL->sequence( 5 ) + 1,
        );
    }
}

package Test::BothTags {

    use Moo;
    use MooX::PDL::Role::Proxy;

    has p1 => (
        is      => 'rwp',
        piddle  => 1,
        ndarray => 1,
    );

    has p2 => (
        is      => 'rwp',
        piddle  => 1,
        ndarray => 1,
    );
}


Test->test(
    'where',
    sub { $_[0]->where( $_[0]->p1 % 2 ) },
    p1 => [ 1, 3 ],
    p2 => [ 2, 4 ],
);

Test->test(
    'index',
    sub { $_[0]->index( PDL->new( 0, 1, 3 ) ) },
    p1 => [ 0, 1, 3 ],
    p2 => [ 1, 2, 4 ],
);

Test->test(
    'copy',
    sub { $_[0]->copy },
    p1 => [ 0, 1, 2, 3, 4 ],
    p2 => [ 1, 2, 3, 4, 5 ],
);

subtest 'at' => sub {
    my $o  = Test->test_obj;
    my $at = $o->at( 3 );
    is( $at->p1, 3, 'p1' );
    is( $at->p2, 4, 'p2' );
};

subtest '_ndarrays returns single entry for attribute tagged as both  piddle and ndarray' => sub {
    my $o = Test::BothTags->new;

    is(
        $o->_ndarrays,
        bag {
            item 'p1';
            item 'p2';
            end;
        },
        'returns each tagged attribute once',
    );

    is(
        $o->_piddles,
        bag {
            item 'p1';
            item 'p2';
            end;
        },
        '_piddles alias is also deduplicated',
    );
};


subtest 'sever' => sub {

    my $o = Test->test_obj;

    my $n = $o->index( PDL->new( 0, 1, 3 ) );

    $n->p1->set( 0, 22 );

    is( $o->p1->at( 0 ), 22, 'not severed' );

    my $c = $n->sever;
    $n->p1->set( 0, 24 );
    is( $o->p1->at( 0 ), 22, 'severed' );
    ref_is( $c, $n, 'sever returns self' );
};

subtest 'clone with args' => sub {

    my $o = Test->test_obj;
    $o->_set_clone_args( { a1 => 3 } );

    my $c = $o->copy;

    if ( My::Test::NAME eq 'NDarray' ) {
        ok( $c->has_a1 && $c->a1 == 3 );
    }
    else {
        ok( !$c->has_a1 );
    }

};

done_testing;
