The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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');