package ATR::UtilTest;

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

use ATR::Util;

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

sub test_make_args {
    my $self = shift;
    my @defaults = (-bar => 8, -foo => 0, -baz => undef);

    # Check pass-through of given values, defaults all overridden; list context
    my %out = make_args([ -baz => "ll", -foo => undef, -bar => 3 ], \@defaults);
    $self->{annotate}->{out} = \%out;
    $self->assert_deep_equals({ -foo => undef,
				-bar => 3,
				-baz => "ll" },
			      \%out);

    # Use some defaults; scalar context
    my $out = $self->{annotate}->{out} = make_args([ -foo => 5 ], \@defaults);
    $self->assert_deep_equals({ -foo => 5,
				-bar => 8,
				-baz => undef },
			      $out
			     );
    delete $self->{annotate};

    # Check errors
    $self->assert_dies(qr/Odd number/,
		       sub { %out = make_args([ -foo => 4, 7 ], \@defaults) },
		       sub { %out = make_args([ -foo => 4 ], [ -foo => 4, 7]) });
    $self->assert_dies(qr/Unknown arg.*wibble/,
		       sub { %out = make_args([ -wibble => 7 ], \@defaults) });
}


sub test_asi {
    my $self = shift;

    $self->fail unless McaTestCase->asi($self);
    $self->fail unless Test::Unit::TestCase->asi($self);

    my $junk = bless {}, 'Junk';
    my $wibble = bless {}, 'Wibble';

    # Try an assortment of combinations
    my @true  = ('ATR::UtilTest' => $self,
		 'Test::Unit::TestCase' => $self,
		 McaTestCase =>  $self,
		 Wibble => $wibble,
		 Junk => $junk,
		);
    my @false = ('B::Deparse' => $self,
		 McaTestCase => undef,
		 McaTestCase => 15,
		 Wibble => $junk,
		 Junk => $wibble,
		 Junk => $self,
		);
    for (my $i=0; @true > 2*$i; $i++) {
	my ($class, $obj) = @true[2*$i, 1+2*$i];
	my $T = "\$true[$i] $class:";
	$self->fail("$T UNIVERSAL::isa not") unless UNIVERSAL::isa($obj, $class);
	$self->fail("$T method isa not")     unless $obj->isa($class);
	$self->fail("$T UNIVERSAL::asi not") unless UNIVERSAL::asi($class, $obj);
	$self->fail("$T class asi not")      unless $class->asi($obj);
	$self->fail("$T class asi not")      unless $class->asi($obj, 12, "dull", "ignored");
    }

    for (my $i=0; @false > 2*$i; $i++) {
	my ($class, $obj) = @false[2*$i, 1+2*$i];
	my $T = "\$false[$i] $class:";
	$self->fail("$T UNIVERSAL::isa not") if UNIVERSAL::isa($obj, $class);
## this is the thing you can't do, because $obj may not be an object
#  and that's why I want an 'asi' method
#	$self->fail("$T method isa not") unless $obj->isa($class);
	$self->fail("$T UNIVERSAL::asi not") if UNIVERSAL::asi($class, $obj);
	$self->fail("$T class asi not") if $class->asi($obj);
	$self->fail("$T noarg") if $class->asi();
    }
}


1;
