view release on metacpan or  search on metacpan

t/core/class.t  view on Meta::CPAN

# Test the Badger::Class module.
#
# Written by Andy Wardley <abw@wardley.org>
#
# This is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
#========================================================================

use lib qw( t/core/lib ../t/core/lib ./lib ../lib ../../lib );
BEGIN { $Badger::Class::DEBUG = 1 if grep /-d/, @ARGV }
use Badger::Class;
use Badger::Test
    tests => 133,
    debug => 'Badger::Class Badger::Exporter',
    args  => \@ARGV;


#-----------------------------------------------------------------------
# test simple inheritance
#-----------------------------------------------------------------------

package Alice;
use Badger::Class 
    version => 2.718,
    import  => qw( class classes CLASS );

main::is( $VERSION, 2.718, 'Alice defines $VERSION as 2.718' );
our $NAME = 'Alice';
our $GIRLS_NAME = 'Alice';
our $ALIASES = ['Ally', 'Ali'];
our $FRIENDS = {
    sue => 'Susan',
};
our $TWO = '22 Acacia Avenue';

sub new {
    my ($class, %self) = @_;
    bless \%self, $class;
}

sub my_class { CLASS }

package Bob;
use Badger::Class
    base    => 'Alice',
    version => 3.142;

our $NAME = 'Bob';
our $BOYS_NAME = 'Bob';
our $ALIASES = ['Robert', 'Rob'];
our $FRIENDS = {
    jim => 'Jim',
};
our $ONE = '2 Minutes to Midnight';

package main;

# base methods
my $alice = Alice->new();
ok( $alice, 'Alice is alive' );
is( $alice->class, 'Alice', "Alice's class is Alice" );
is( $alice->VERSION, 2.718, "Alice's version is 2.718" );
is( $Alice::VERSION, 2.718, "Alice's VERSION is 2.718" );

# derived methods
my $bob = Bob->new();
ok( $bob, 'Bob is alive' );
is( $bob->class, 'Bob', "Bob's class is Bob" );
is( $bob->class->parents->[0], 'Alice', "Bob's parent is Alice" );
is( join(', ', $bob->class->heritage), 'Bob, Alice', "Bob's heritage is Bob, Alice" );
is( join(', ', $bob->classes), 'Bob, Alice', "Bob's classes are Bob, Alice" );
is( $bob->VERSION, 3.142, "Bob has version of 3.142" );

# base vars
is( $alice->class->var('NAME'), 'Alice', 'Alice var $NAME' );
is( $alice->class->var('GIRLS_NAME'), 'Alice', 'Alice var $GIRLS_NAME' );

# derived vars
is( $bob->class->var('NAME'), 'Bob', 'Bob var $NAME' );
is( $bob->class->var('BOYS_NAME'), 'Bob', 'Bob var $BOYS_NAME' );

is( join(', ', $alice->class->any_var('NAME')), 'Alice', 'Alice any_var $NAME' );
is( join(', ', $bob->class->any_var('NAME')), 'Bob', 'Bob any_var $NAME' );

is( join(', ', $alice->class->any_var_in('ONE', 'TWO')), '22 Acacia Avenue', 'Alice is Charlotte' );
is( join(', ', $alice->class->any_var_in('ONE TWO')), '22 Acacia Avenue', 'She lives at 22 Acacia Avenue' );
is( join(', ', $alice->class->any_var_in(['ONE', 'TWO'])), '22 Acacia Avenue', "That's the place where we all go" );
is( join(', ', $bob->class->any_var_in('ONE', 'TWO')), '2 Minutes to Midnight', "Bob says it's 2 minutes to midnight" );
is( join(', ', $bob->class->any_var_in('ONE TWO')), '2 Minutes to Midnight', "The hand that threatens doom" );
is( join(', ', $bob->class->any_var_in(['ONE', 'TWO'])), '2 Minutes to Midnight', "Kill the unborn in the womb" );

is( join(', ', $alice->class->all_vars('NAME')), 'Alice', 'Alice all_vars $NAME' );
is( join(', ', $bob->class->all_vars('NAME')), 'Bob, Alice', 'Bob all_vars $NAME' );

# merged list var
is( join(', ', @{ $alice->class->list_vars('ALIASES') }), 'Ally, Ali', 'Alice ALIASES' );
is( join(', ', @{ $bob->class->list_vars('ALIASES') }), 'Robert, Rob, Ally, Ali', 'Bob ALIASES' );

# merged hash var
my $friends = $alice->class->hash_vars('FRIENDS');
is( join(', ', keys %$friends), 'sue', 'Alice FRIENDS with sue' );
is( join(', ', values %$friends), 'Susan', 'Alice FRIENDS with Susan' );

$friends = $bob->class->hash_vars('FRIENDS');
is( join(', ', sort keys %$friends), 'jim, sue', 'Bob FRIENDS with jim and sue' );
is( join(', ', sort values %$friends), 'Jim, Susan', 'Bob FRIENDS with Jim and Susan' );

# check that CLASS works
is( $alice->my_class, 'Alice', 'Alice has my_class set to Alice' );
is( $bob->my_class, 'Alice', "Bob also has my_class set to Alice, but that's OK" );


#-----------------------------------------------------------------------
# test inheritance via the base() method
#-----------------------------------------------------------------------

package Charlie;
use Badger::Class 
    import  => 'class';

class->base('Alice');

package main;
my $chas = Charlie->new();
ok( $chas, 'Created Charlie' );
is( $chas->VERSION, 2.718, 'Charlie inherits version from Alice' );