The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
##
## Tests for Pixie (no top-level API tests here)
##

use lib 't/lib';
use blib;
use strict;
use warnings;

use Test::More qw( no_plan );
use Test::Exception;
use Test::MockObject;

BEGIN { use_ok( 'Pixie' ); }

my $pixie = Pixie->new;

## init
isa_ok( $pixie->store, 'Pixie::Store::Memory', 'init connects to memory' );

## as_string
like( $pixie->as_string, qr/^Pixie: .+Pixie::Store::Memory/s, 'as_string' );

## get_the_current...
is( $pixie->get_the_current_pixie, undef,         'get_the_current_pixie' );
is( $pixie->get_the_current_oid,   undef,         'get_the_current_oid' );
is( $pixie->get_the_current_lock_strategy, undef, 'get_the_current_lock_strategy' );
is( $pixie->get_the_current_object_graph, undef,  'get_the_current_object_graph' );

## _oid
ok( $pixie->_oid, '_oid' );

## clear_store
ok( $pixie->clear_store, 'clear_store' );
ok( ! $pixie->store,     ' store deleted' );

$pixie = Pixie->new;

## clear_storage
{
    # can't use Test::MockObject here
    $pixie->store->store_at( 'test oid' => bless {}, 'Foo' );
    $pixie->clear_storage;
    ok( ! $pixie->store->get_object_at( 'test oid' ), 'clear_storage' );
}

## lock_strategy / lock_strategy_for
{
    # lock_strategy
    my $lockstrat = $pixie->lock_strategy;
    isa_ok( $lockstrat, 'Pixie::LockStrat::Null', 'lock_strategy, lazy init' );
    is( $pixie->lock_strategy( 'foo' ), $pixie,   'lock_strategy, set' );
    is( $pixie->lock_strategy, 'foo',             'lock_strategy, get' );

    # lock_strategy_for
    $pixie->{_objectmanager} = Test::MockObject->new
      ->set_always( lock_strategy_for => 'foo' );
    is( $pixie->lock_strategy_for( 'oid' ), 'foo',         'lock_strategy_for (get)' );
    is( $pixie->lock_strategy_for( 'oid', 'set' ), $pixie, 'lock_strategy_for (set)' );

    $lockstrat->{on_DESTROY_called} = 1; # avoid warnings
}

## store_individual / store_individual_at
{
    $pixie  = Pixie->new->lock_strategy( Pixie::LockStrat::Null->new );
    my $obj = bless {}, 'Foo';
    $obj->PIXIE::set_oid( 'my_oid' );

    # this calls both methods:
    my $proxy = $pixie->store_individual( $obj );
    isa_ok( $proxy, 'Pixie::Proxy::HASH',         'store_individual' );
    ok( $pixie->store->get_object_at( 'my_oid' ), ' obj found in store' );

    throws_ok
      { $pixie->store_individual( Pixie::ObjectInfo->new ) }
      qr/can.t store a/i,
      'store_individual px object info';

    $pixie->lock_strategy->{on_DESTROY_called} = 1; # avoid warnings
}

## proxied_content / proxy_finder
{
    my $pixie  = Pixie->new;
    my $obj    = bless { bar => 'baz' }, 'Bar';
    $obj->PIXIE::set_oid( 'bar_oid' );
    my $proxy  = Pixie::Proxy->px_make_proxy( bar_oid => $obj );

    local %Pixie::neighbours;
    is( Pixie::proxy_finder( $proxy ), $proxy, 'proxy_finder' );
    ok( $Pixie::neighbours{bar_oid},           ' finds proxies' );

    my $holder = bless({ oid     => 'my oid',
			 class   => 'Foo',
			 content => { foo => $proxy } },
		       'Pixie::ObjHolder' );
    my @neighbours = $pixie->proxied_content( $holder );
    is_deeply( \@neighbours, [ 'bar_oid' ], 'proxied_content' );
}

## insertion_freeze / insertion_thaw
{
    my $pixie   = Pixie->new;
    my $manager = $pixie->{_objectmanager};
    my $obj     = bless { foo => 1 }, 'Foo';
    my $holder  = $pixie->insertion_freeze( $obj );

    # freeze
    isa_ok( $holder, 'Pixie::ObjHolder', 'insertion_freeze' );
    ok( $holder->{oid},                  ' holder->oid' );
    is( $holder->{class}, 'Foo',         ' holder->class' );
    is_deeply( $holder->{content}, $obj, ' holder->content' );
    ok( $manager->cache_get( $holder->{oid} ),
	' object is cached in object manager' );

    my $info = $manager->get_info_for_oid( $holder->{oid} );
    ok( $info, ' cached obj has info' );

    # thaw
    my $obj2  = bless { bar => 1 }, 'Bar';
    my $proxy = Pixie::Proxy->px_make_proxy( bar_oid => $obj2 );
    my $graph = Pixie::ObjectGraph->new;

    no warnings;
    local *Pixie::get_the_current_object_graph = sub { $graph };
    use warnings;

    $holder->{content}->{bar} = $proxy;

    my $proxy1 = $pixie->insertion_thaw( $holder );
    isa_ok( $proxy1, 'Pixie::Proxy::HASH',     'insertion_thaw' );
    is( $proxy1->_oid, $holder->{oid},         ' proxy has right oid' );
    is( $info->the_object, $obj,               ' object info has right obj' );
    my @neighbours = $graph->neighbours( $holder->{oid} );
    is_deeply( \@neighbours, ['bar_oid'],      ' object graph is populated' );
}

## do_dump_and_eval
{
    $pixie  = Pixie->new;
    my $obj = bless { foo => 1, bar => bless ['eek'], 'Bar' };

    no warnings;
    local *Pixie::lock_store = sub { 1 };
    local *Pixie::lock_store = sub { 1 };
    use warnings;

    my $copy = $pixie->do_dump_and_eval( $obj );
    is_deeply( $copy, $obj, 'do_dump_and_eval' );
    isnt( $copy, $obj, ' creates a deep copy' );
}

## _insert


## insert (tested in api tests)

## get (tested in api tests)
## get_with_strategy
## bail_out
## delete (tested in api tests)
## forget_about

## make_new_object
{
    my $pixie = Pixie->new;
    my $obj   = bless { foo => 'bar' }, 'Foo';
    local *Foo::new = sub { bless {}, $_[0] };

    my $obj2 = $pixie->make_new_object( $obj, 'Foo' );
    isa_ok( $obj2, 'Foo',   'make_new_object' );
    isnt( $obj2, $obj,      ' obj is a copy' );
    is_deeply( $obj2, $obj, ' obj is same as original' );
}

## extraction_freeze / extraction_thaw
{
    my $pixie = Pixie->new;
    my $obj   = bless { foo => 'bar' }, 'Foo';
    is( $pixie->extraction_freeze( $obj ), $obj, 'extraction_freeze' );

    local *Foo::new = sub { bless {}, $_[0] };
    local $Pixie::the_current_oid   = 'foo_oid';
    local $Pixie::the_current_pixie = $pixie;

    my $obj2 = $pixie->extraction_thaw( $obj );
    isa_ok( $obj2, 'Foo',             'extraction_thaw' );
    isnt( $obj2, $obj,                ' obj is a copy' );
    is_deeply( $obj2, $obj,           ' obj is same as original' );
    is( $obj2->PIXIE::oid, 'foo_oid', ' obj has right oid' );
    isa_ok( $obj, 'Class::Whitehole', ' original obj' );
}

## _get

## manages_object
{
    my $pixie = Pixie->new;
    my $obj   = bless {}, 'Foo';
    ok( ! $pixie->manages_object( $obj ), 'manages_object, not managed' );
    $pixie->insert( $obj );
    ok( $pixie->manages_object( $obj ), 'manages_object' );
}

## Caching methods
{
    # These should be tested in Pixie::LiveObjectManager tests:
    my $pixie       = Pixie->new;
    my $obj_manager = Test::MockObject->new
      ->set_always( cache_insert => 'ins' )
      ->set_always( cache_get    => 'get' )
      ->set_always( cache_delete => 'del' )
      ->set_always( cache_size   => 'size' )
      ->set_always( cache_keys   => 'keys' );
    $pixie->{_objectmanager} = $obj_manager;
    is( $pixie->cache_insert, 'ins',      'cache_insert' );
    is( $pixie->cache_get, 'get',         'cache_get' );
    is( $pixie->cache_delete, 'del',      'cache_delete' );
    is( $pixie->cache_size, 'size',       'cache_size' );
    is( $pixie->get_cached_keys, 'keys',  'get_cached_keys' );
}

## Naming methods
{
    # These should be tested in Pixie::Name tests:
    my $pixie = Pixie->new;

    no warnings;
    local *Pixie::Name::name_object_in   = sub { 'name_in' };
    local *Pixie::Name::remove_name_from = sub { 'remove' };
    local *Pixie::Name::get_object_from  = sub { 'get' };
    use warnings;

    is( $pixie->bind_name, 'name_in',    'bind_name' );
    is( $pixie->unbind_name, 'remove',   'unbind_name' );
    is( $pixie->get_object_named, 'get', 'get_object_named' );
}

## rootset
## add_to_rootset
## neighbours
## run_GC
## live_set
## object_graph
## working_set
## ensure_storability

## Locking methods
{
    # These should be tested in Pixie::Store tests:
    my $pixie = Pixie->new;
    my $store = Test::MockObject->new
      ->set_always( lock     => 'slock' )
      ->set_always( unlock   => 'sunlock' )
      ->set_always( rollback => 'srollback' )
      ->set_always( release_all_locks => 1 );
    $pixie->store( $store );
    is( $pixie->lock_store, 'slock',         'lock_store' );
    is( $pixie->unlock_store, 'sunlock',     'unlock_store' );
    is( $pixie->rollback_store, 'srollback', 'rollback_store' );

    # These should be tested in Pixie::LiveObjectManager:
    my $obj_manager = Test::MockObject->new
      ->set_always( lock_object   => 'lock' )
      ->set_always( unlock_object => 'unlock' );
    $pixie->{_objectmanager} = $obj_manager;
    is( $pixie->lock_object, 'lock',     'lock_object' );
    is( $pixie->unlock_object, 'unlock', 'unlock_object' );
}

## DESTROY

## px_freeze
## _px_extraction_thaw