#!/usr/bin/perl -w                                         # -*- perl -*-
#========================================================================
#
# test.pl
#
# Test the Class::Facade.pm module.
#
# Written by Andy Wardley <abw@kfs.org>
#
# This is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# $Id$
#
#========================================================================

use strict;
use warnings;
use lib qw( ./lib );
use Class::Facade;


local $" = ', ';

#------------------------------------------------------------------------
# mini test harness
#------------------------------------------------------------------------

print "1..30\n";
my $n = 0;

sub ok {
    my $flag = shift;
    print(($flag ? 'ok ' : 'not ok '), ++$n, "\n");
    return $flag;
}

sub is {
    ok( $_[0] eq $_[1] ) || warn "match failed:\n  GOT: $_[0]\n  NOT: $_[1]\n";
}

sub assert {
    ok( @_ ) || die "assertion failed\n";
}


#------------------------------------------------------------------------
# delegate class
#------------------------------------------------------------------------

package My::Delegate::Class;

sub new {
    my $class = shift;
    bless { @_ }, $class;
}

sub name {
    my $self = shift;
    return "name: $self->{ name } [@_]";
}

sub holler {
    my $class = shift;
    return "$class holler [@_]";
}


#------------------------------------------------------------------------

package main;

my $delegate = My::Delegate::Class->new( name => 'fred' );

assert( $delegate );

my $facade = Class::Facade->new(
    bad => { },
);

is(  Class::Facade->error(), "bad: no 'class' or 'object' specified" );			    
is( $Class::Facade::ERROR,   "bad: no 'class' or 'object' specified" );			    
    

$facade = Class::Facade->new({
    foo => sub { "this is foo [@_]" },
    bar => [ 'My::Delegate::Class', 'holler', 2, 3, 5 ],
    baz => [ $delegate, 'name' ],
    boz => [ $delegate, 'name', 17, 19, 23 ],
    wiz => { 
	class  => 'My::Delegate::Class', 
	method => 'holler',
	args   => [ 27, 29, 31 ],
    },
    waz => {
	object => $delegate, 
	method => 'name', 
	args   => [ 37, 41, 43 ],
    },
});

ok( $facade ) || die "facade error: $Class::Facade::ERROR\n";
assert( $facade );

is( $facade->foo, 'this is foo []' );
is( $facade->foo(10, 20), 'this is foo [10, 20]' );
is( $facade->bar(), 'My::Delegate::Class holler [2, 3, 5]' );
is( $facade->bar(7, 11, 13), 'My::Delegate::Class holler [2, 3, 5, 7, 11, 13]' );
is( $facade->baz(), 'name: fred []' );
is( $facade->boz(7, 11, 13), 'name: fred [17, 19, 23, 7, 11, 13]' );
is( $facade->wiz(), 'My::Delegate::Class holler [27, 29, 31]' );
is( $facade->wiz(10, 20, 30), 'My::Delegate::Class holler [27, 29, 31, 10, 20, 30]' );
is( $facade->waz(), 'name: fred [37, 41, 43]' );
is( $facade->waz(10, 20, 30), 'name: fred [37, 41, 43, 10, 20, 30]' );


#------------------------------------------------------------------------
# test subclass
#------------------------------------------------------------------------

package My::Facade;
use base qw( Class::Facade );
our $ERROR;

package main;

$delegate = My::Delegate::Class->new( name => 'tommy' );

assert( $delegate );

$facade = My::Facade->new(
    bad => { },
);

is(  My::Facade->error(), "bad: no 'class' or 'object' specified" );			    
is( $My::Facade::ERROR,   "bad: no 'class' or 'object' specified" );			    

$facade = My::Facade->new({
    oof => sub { "this is oof [@_]" },
    rab => [ 'My::Delegate::Class', 'holler', 5, 3, 2 ],
    zab => [ $delegate, 'name' ],
    zob => [ $delegate, 'name', 23, 19, 17 ],
    ziw => { 
	class  => 'My::Delegate::Class', 
	method => 'holler',
	args   => [ 31, 29 ],
    },
    zaw => {
	object => $delegate, 
	method => 'name', 
	args   => [ 43, 41, 37 ],
    },
});

ok( $facade ) || die "facade error: $My::Facade::ERROR\n";
assert( $facade );

is( $facade->oof, 'this is oof []' );
is( $facade->oof(10, 20), 'this is oof [10, 20]' );
is( $facade->rab(), 'My::Delegate::Class holler [5, 3, 2]' );
is( $facade->rab(7, 11, 13), 'My::Delegate::Class holler [5, 3, 2, 7, 11, 13]' );
is( $facade->zab(), 'name: tommy []' );
is( $facade->zob(7, 11, 13), 'name: tommy [23, 19, 17, 7, 11, 13]' );
is( $facade->ziw(), 'My::Delegate::Class holler [31, 29]' );
is( $facade->ziw(10, 20, 30), 'My::Delegate::Class holler [31, 29, 10, 20, 30]' );
is( $facade->zaw(), 'name: tommy [43, 41, 37]' );
is( $facade->zaw(10, 20, 30), 'name: tommy [43, 41, 37, 10, 20, 30]' );