The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!/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');