#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 49;
use overload ();
BEGIN {
unshift @INC => ('t/test_lib', '/test_lib');
}
# we have to use it directly because it uses an INIT block to flatten traits
use TraitTest;
can_ok("TraitTest", 'new');
my $trait_1 = TraitTest->new(3);
my $trait_2 = TraitTest->new(3);
isa_ok($trait_1, 'TraitTest');
isa_ok($trait_1, 'TraitTestBase');
isa_ok($trait_2, 'TraitTest');
isa_ok($trait_2, 'TraitTestBase');
ok($trait_1->does("TPrintable"), '... trait 1 is TPrintable');
ok($trait_1->does("TCompositeTest"), '... trait 1 is TCompositeTest');
ok($trait_1->does("TComparable"), '... trait 1 is TComparable (becuase of TCompositeTest');
ok($trait_2->does("TPrintable"), '... trait 2 is TPrintable');
ok($trait_2->does("TCompositeTest"), '... trait 2 is TCompositeTest');
ok($trait_2->does("TComparable"), '... trait 2 is TComparable (becuase of TCompositeTest');
# check that it "can" execute the methods
# that it should have gotten from the traits
foreach my $method (qw/ compositeTestRequirement compositeTest /, # from CompositeTest
qw/ toString stringValue /, # from TPrintable
qw/ compare equalTo notEqualTo /, # from TComparable
) {
can_ok($trait_1, $method);
can_ok($trait_2, $method);
}
# test the aliased method strVal
can_ok($trait_1, 'strVal');
can_ok($trait_2, 'strVal');
# check overloads as well....
# for TComparable
ok(overload::Method($trait_1, '=='), '... trait 1 overload ==');
ok(overload::Method($trait_1, '!='), '... trait 1 overload !=');
ok(overload::Method($trait_1, '<=>'), '... trait 1 overload <=>');
# for TPrintable
ok(overload::Method($trait_1, '""'), '... trait 1 overload ""');
# for TComparable
ok(overload::Method($trait_2, '=='), '... trait 2 overload ==');
ok(overload::Method($trait_2, '!='), '... trait 2 overload !=');
ok(overload::Method($trait_2, '<=>'), '... trait 2 overload <=>');
# for TPrintable
ok(overload::Method($trait_2, '""'), '... trait 2 overload ""');
# now check if they behave as we expect
# check "" operator from TPrintable
is("$trait_1", '3.000 (overridden stringification)',
'... and it should be stringified correctly');
is("$trait_2", '3.000 (overridden stringification)',
'... and it should be stringified correctly');
# check == operator from TComparable
cmp_ok($trait_1, '==', $trait_2,
'... and they should be equal');
# check != operator from TComparable
ok(!($trait_1 != $trait_2),
'... and they shouldnt be not equal');
# check the compare <=> operator
cmp_ok(($trait_1 <=> $trait_2), '==', 0,
'... and they shouldnt be equal and therefore <=> return 0');
# check the aliased stringValue function
like($trait_1->strVal, qr/TraitTest=HASH\(0x[a-fA-F0-9]+\)/,
'... and should return a reasonable strVal');
like($trait_2->strVal, qr/TraitTest=HASH\(0x[a-fA-F0-9]+\)/,
'... and should return a reasonable strVal');
# now lets extract the actul trait and examine it
my $trait;
{
no strict 'refs';
# get the trait out
$trait = ${"TraitTest::TRAITS"};
}
# check to see it is what we want it to be
isa_ok($trait, 'Class::Trait::Config');
# now examine the trait itself
is($trait->name, 'COMPOSITE', '... get the traits name');
ok(eq_array(
$trait->sub_traits,
[ 'TCompositeTest', 'TPrintable' ])
, '... this should not be empty');
ok(eq_hash($trait->conflicts, {}), '... this should be empty');
ok(eq_hash(
$trait->requirements,
{
compare => 1,
compositeTestRequirement => 1,
toString => 2 # this was required twice
})
, '... this should not be empty');
ok(eq_hash(
$trait->overloads,
{
'<=>' => 'compare',
'==' => 'equalTo',
'""' => 'toString',
'!=' => 'notEqualTo'
})
, '... this should not be empty');
ok(eq_set(
[ keys %{$trait->methods} ],
['stringValue', 'compositeTest', 'strVal', 'equalTo', 'notEqualTo', 'isSameTypeAs', 'isExactly'])
, '... this should not be empty');