package ObjCacheVictim; # a small test-object class before the test code

sub new {
    my ($proto, @key) = @_;
    bless { key => [@key] }, (ref($proto) || $proto);
}
sub key  { $_[0]->{key}->[$_[1]] }
sub key0 { $_[0]->{key}->[0] }
sub key1 { $_[0]->{key}->[1] }
sub key2 { $_[0]->{key}->[2] }
sub info { join "|", @{ $_[0]->{key} } }


package ATR::ObjCacheTest;

use strict;
use warnings;
use base qw(McaTestCase);

# $Source: /nfs/disk54/badger/cvs/AniTrack/testlib/ATR/ObjCacheTest.pm,v $
# $Revision: 1.6 $ $Date: 2005/08/18 15:54:37 $

use ATR::ObjCache;

# XXX:UNTESTED ObjCache->currentKeys method

sub test_onekey {
    my $self = shift;

    my $C = ATR::ObjCache->new( useweak => 0,
				keyfuncs => { ObjCacheVictim => 'key0' },
			      );
    my %v = map {( $_ => ObjCacheVictim->new( $_ ) )} qw( a b c d e );

    $self->check_hits($C, {}, [qw[ a b c d e f g h i]]);

    # Also check my check_hits function works (several places in this test)
    $self->check_hits($C, {}, []);
    $self->assert_raises('Test::Unit::Failure',
			 sub { $self->check_hits($C, { a => $v{a} }, []) });

    # Put and get
    $C->put($v{a}, $v{b});
    $self->check_hits($C, { a => $v{a}, b => $v{b} }, [qw[ c d e f g h i]]);

    $self->check_hits($C, {}, []);
    $self->assert_raises('Test::Unit::Failure',
			 sub { $self->check_hits($C, { c => $v{c} }, []) });
    $self->assert_raises('Test::Unit::Failure',
			 sub { $self->check_hits($C, {}, [qw[ a ]]) });
    $self->assert_raises('Test::Unit::Failure',
			 sub { $self->check_hits($C, { a => $v{c} }, []) });

    # Re-put and get
    $C->put($v{b}, $v{c});
    $self->check_hits($C, { a => $v{a}, b => $v{b}, c => $v{c} }, [qw[ d e f g h i]]);

    # Drop, put, get
    $C->drop($v{a});
    $C->put(@v{qw{d e}});
    $self->check_hits($C, { b => $v{b}, c => $v{c}, d => $v{d}, e => $v{e} }, [qw[a f g h i]]);

    # Check cache holds refs after we dropped ours
    %v = ();
    $self->check_hits($C, {}, [qw[a f g h i]]);
    foreach my $k (qw( b c d e )) {
	my $v = $C->get($k);
	$self->assert_str_equals($k, $v->key0);
    }

    # Drop the rest
    foreach my $k (qw( b c d e )) {
	$C->drop( $C->get($k) );
    }
    $self->check_hits($C, {}, [qw[a b c d e f g]]); # all gone
}

sub test_weak {
    my $self = shift;

    my $C = ATR::ObjCache->new( useweak => 1,
				keyfuncs => { ObjCacheVictim => 'key0' });
    my %v = map {( $_ => ObjCacheVictim->new( $_ ) )} qw( a b c d e );
    $C->put(values %v);

    $self->check_hits($C, \%v, [qw[f g wibble]]);

    %v = ();
    $self->check_hits($C, {}, [qw[a b c d e f g]]); # all gone
}

sub test_errors {
    my $self = shift;

    my $C = ATR::ObjCache->new( useweak => 1,
				keyfuncs => { ObjCacheVictim => 'key0' });

    $self->assert_dies(qr/Unknown arguments .* given/,
		       sub { ATR::ObjCache->new(wibble => 5) });

    $self->assert_dies(qr/unknown object type (ATR::ObjCacheTest|Junk)/,
		       sub { $C->drop($self) },
		       sub { $C->put($self) },
		       sub { $C->put(bless {}, "Junk") },
		       sub { $C->drop(bless {}, "Junk") },
		      );
    $C->drop( ObjCacheVictim->new('z') ); # was never added
}


sub check_hits {
    my ($self, $cache, $hits, $misses) = @_;
    my @caller = caller();
    my $caller = "caller at $caller[1] line $caller[2]";

    while (my ($k, $exp) = each %$hits) {
	my $actual = $cache->get($k);
	if (!defined $actual) {
	    $self->fail("$caller: wanted hit '$k', got undef");
	} elsif ($exp == $actual) {
	    # OK
	} else {
	    my $ak = $cache->key($actual);
	    my $info = $actual->info;
	    $self->fail("$caller: wanted hit '$k', got $actual ($info, key $ak)");
	}
    }

    foreach my $k (@$misses) {
	my $actual = $cache->get($k);
	next if !defined $actual; # OK
	my $ak = $cache->key($actual);
	my $info = $actual->info;
	$self->fail("$caller: wanted miss '$k', got $actual ($info, key $ak)");
    }
}

1;
