1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 20;
BEGIN {
unshift @INC => ('t');
}
# this will test if
BEGIN {
package Test::Class::LoadingTraitsWithColonsInThem;
use Class::Trait qw(Test::LoadingTraitsWithColonsInThem);
sub new { bless {} }
}
{
can_ok( "Test::Class::LoadingTraitsWithColonsInThem", 'new' );
my $test = Test::Class::LoadingTraitsWithColonsInThem->new();
can_ok( $test, 'does' );
ok(
$test->does('Test::LoadingTraitsWithColonsInThem'),
'... our trait was compiled successfully'
);
can_ok( $test, 'isLoaded' );
is(
$test->isLoaded(),
'Test::LoadingTraitsWithColonsInThem',
'... and our trait method is as we expected'
);
}
BEGIN {
package Test::Class::Another::ColonInTheName;
use Class::Trait qw(Test::Another::ColonInTheName);
sub new { bless {} }
}
{
can_ok( "Test::Class::Another::ColonInTheName", 'new' );
my $test = Test::Class::Another::ColonInTheName->new();
can_ok( $test, 'does' );
ok(
$test->does('Test::Another::ColonInTheName'),
'... our trait was compiled successfully'
);
can_ok( $test, 'isLoaded' );
is(
$test->isLoaded(),
'Test::Another::ColonInTheName',
'... and our trait method is as we expected'
);
}
# test some of the Trait lib
{
package Test::TEquality;
use Class::Trait qw(TEquality);
sub new {
my ( $class, $num ) = @_;
return bless { num => $num }, $class;
}
sub equalTo {
my ( $left, $right ) = @_;
if ( ref($right) ) {
return $left->{num} == $right->{num};
}
else {
return $left->{num} == $right;
}
}
}
# test TEquality
{
my $test1 = Test::TEquality->new(5);
my $test2 = Test::TEquality->new(5);
my $test3 = Test::TEquality->new(10);
ok( ( $test1 == $test2 ), '... our values compare correctly' );
ok( ( $test2 == 5 ), '... our values compare correctly' );
ok( ( $test1 != $test3 ), '... our values compare correctly' );
ok( $test1->isSameTypeAs($test2), '... our objects are the same type' );
ok( !$test1->isSameTypeAs("test"),
'... our objects are not the same type' );
ok( $test1->isExactly($test1), '... our objects are the same type' );
ok( !$test1->isExactly($test2), '... our objects not are the same type' );
}
{
package Test::TComparable;
use Class::Trait qw(TComparable);
sub new {
my ( $class, $num ) = @_;
return bless { num => $num }, $class;
}
sub compare {
my ( $left, $right ) = @_;
return $left->{num} <=> $right->{num};
}
}
{
my $test1 = Test::TComparable->new(1);
my $test2 = Test::TComparable->new(5);
my $test3 = Test::TComparable->new(10);
my @sorted = sort { $a <=> $b } $test3, $test1, $test2;
is( "$sorted[0]", "$test1", '... got the right first item' );
is( "$sorted[1]", "$test2", '... got the right second item' );
is( "$sorted[2]", "$test3", '... got the right third item' );
}
|
