#!/usr/bin/perl
use strict;
use warnings;
{
package Not::main;
# this is imported into a different package to avoid conflicts with "is()"
use Test::More tests => 52;
}
use overload ();
BEGIN {
unshift @INC => ('t/test_lib', '/test_lib');
# we have to require Class::Trait to avoid importing
# and it must be in a BEGIN block to ensure that rename_does
# fires before the does() method is installed
require Class::Trait;
Test::More::can_ok 'Class::Trait', 'rename_does';
eval { Class::Trait->rename_does('$$') };
Test::More::like $@, qr/Illegal name for trait relation method \(\$\$\)/,
'... calling rename_does() with an illegal method name should die';
Test::More::ok +Class::Trait->rename_does('is'),
'... but calling it with a legal method name should succeed';
}
# we have to use it directly because it uses an INIT block to flatten traits
use TraitTest;
Test::More::can_ok("TraitTest", 'new');
my $trait_1 = TraitTest->new(3);
my $trait_2 = TraitTest->new(3);
Test::More::isa_ok($trait_1, 'TraitTest');
Test::More::isa_ok($trait_1, 'TraitTestBase');
Test::More::isa_ok($trait_2, 'TraitTest');
Test::More::isa_ok($trait_2, 'TraitTestBase');
Test::More::ok($trait_1->is("TPrintable"), '... trait 1 is TPrintable');
Test::More::ok($trait_1->is("TCompositeTest"), '... trait 1 is TCompositeTest');
Test::More::ok($trait_1->is("TComparable"), '... trait 1 is TComparable (becuase of TCompositeTest');
Test::More::ok($trait_2->is("TPrintable"), '... trait 2 is TPrintable');
Test::More::ok($trait_2->is("TCompositeTest"), '... trait 2 is TCompositeTest');
Test::More::ok($trait_2->is("TComparable"), '... trait 2 is TComparable (because 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
) {
Test::More::can_ok($trait_1, $method);
Test::More::can_ok($trait_2, $method);
}
# test the aliased method strVal
Test::More::can_ok($trait_1, 'strVal');
Test::More::can_ok($trait_2, 'strVal');
# check overloads as well....
# for TComparable
Test::More::ok(overload::Method($trait_1, '=='), '... trait 1 overload ==');
Test::More::ok(overload::Method($trait_1, '!='), '... trait 1 overload !=');
Test::More::ok(overload::Method($trait_1, '<=>'), '... trait 1 overload <=>');
# for TPrintable
Test::More::ok(overload::Method($trait_1, '""'), '... trait 1 overload ""');
# for TComparable
Test::More::ok(overload::Method($trait_2, '=='), '... trait 2 overload ==');
Test::More::ok(overload::Method($trait_2, '!='), '... trait 2 overload !=');
Test::More::ok(overload::Method($trait_2, '<=>'), '... trait 2 overload <=>');
# for TPrintable
Test::More::ok(overload::Method($trait_2, '""'), '... trait 2 overload ""');
# now check if they behave as we expect
# check "" operator from TPrintable
Test::More::is("$trait_1", '3.000 (overridden stringification)',
'... and it should be stringified correctly');
Test::More::is("$trait_2", '3.000 (overridden stringification)',
'... and it should be stringified correctly');
# check == operator from TComparable
Test::More::cmp_ok($trait_1, '==', $trait_2,
'... and they should be equal');
# check != operator from TComparable
Test::More::ok(!($trait_1 != $trait_2),
'... and they shouldnt be not equal');
# check the compare <=> operator
Test::More::cmp_ok(($trait_1 <=> $trait_2), '==', 0,
'... and they shouldnt be equal and therefore <=> return 0');
# check the aliased stringValue function
Test::More::like($trait_1->strVal, qr/TraitTest=HASH\(0x[a-fA-F0-9]+\)/,
'... and should return a reasonable strVal');
Test::More::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
Test::More::isa_ok($trait, 'Class::Trait::Config');
# now examine the trait itself
Test::More::is($trait->name, 'COMPOSITE', '... get the traits name');
Test::More::ok(Test::More::eq_array(
$trait->sub_traits,
[ 'TCompositeTest', 'TPrintable' ])
, '... this should not be empty');
Test::More::ok(Test::More::eq_hash($trait->conflicts, {}), '... this should be empty');
Test::More::ok(Test::More::eq_hash(
$trait->requirements,
{
compare => 1,
compositeTestRequirement => 1,
toString => 2 # this was required twice
})
, '... this should not be empty');
Test::More::ok(Test::More::eq_hash(
$trait->overloads,
{
'<=>' => 'compare',
'==' => 'equalTo',
'""' => 'toString',
'!=' => 'notEqualTo'
})
, '... this should not be empty');
Test::More::ok(Test::More::eq_set(
[ keys %{$trait->methods} ],
['stringValue', 'compositeTest', 'strVal', 'equalTo', 'notEqualTo', 'isSameTypeAs', 'isExactly'])
, '... this should not be empty');