Commit | Line | Data |
bdabd620 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Test::More tests => 52; |
7 | use Test::Exception; |
8 | |
9 | BEGIN { |
10 | use_ok('Moose'); |
11 | } |
12 | |
13 | ## Roles |
14 | |
15 | { |
16 | package Eq; |
17 | use strict; |
18 | use warnings; |
19 | use Moose::Role; |
20 | |
21 | sub equal_to { confess "equal must be implemented" } |
22 | sub not_equal_to { |
23 | my ($self, $other) = @_; |
24 | !$self->equal_to($other); |
25 | } |
26 | |
27 | package Ord; |
28 | use strict; |
29 | use warnings; |
30 | use Moose::Role; |
31 | |
32 | with 'Eq'; |
33 | |
34 | sub compare { confess "compare must be implemented" } |
35 | |
36 | sub equal_to { |
37 | my ($self, $other) = @_; |
38 | $self->compare($other) == 0; |
39 | } |
40 | |
41 | sub greater_than { |
42 | my ($self, $other) = @_; |
43 | $self->compare($other) == 1; |
44 | } |
45 | |
46 | sub less_than { |
47 | my ($self, $other) = @_; |
48 | $self->compare($other) == -1; |
49 | } |
50 | |
51 | sub greater_than_or_equal_to { |
52 | my ($self, $other) = @_; |
53 | $self->greater_than($other) || $self->equal_to($other); |
54 | } |
55 | |
56 | sub less_than_or_equal_to { |
57 | my ($self, $other) = @_; |
58 | $self->less_than($other) || $self->equal_to($other); |
59 | } |
60 | } |
61 | |
62 | ## Classes |
63 | |
64 | { |
65 | package US::Currency; |
66 | use strict; |
67 | use warnings; |
68 | use Moose; |
69 | |
70 | with 'Ord'; |
71 | |
72 | has 'amount' => (is => 'rw', isa => 'Int', default => 0); |
73 | |
74 | sub compare { |
75 | my ($self, $other) = @_; |
76 | $self->amount <=> $other->amount; |
77 | } |
78 | } |
79 | |
80 | ok(US::Currency->does('Ord'), '... US::Currency does Ord'); |
81 | ok(US::Currency->does('Eq'), '... US::Currency does Eq'); |
82 | |
83 | my $hundred = US::Currency->new(amount => 100.00); |
84 | isa_ok($hundred, 'US::Currency'); |
85 | |
86 | can_ok($hundred, 'amount'); |
87 | is($hundred->amount, 100, '... got the right amount'); |
88 | |
89 | ok($hundred->does('Ord'), '... US::Currency does Ord'); |
90 | ok($hundred->does('Eq'), '... US::Currency does Eq'); |
91 | |
92 | my $fifty = US::Currency->new(amount => 50.00); |
93 | isa_ok($fifty, 'US::Currency'); |
94 | |
95 | can_ok($fifty, 'amount'); |
96 | is($fifty->amount, 50, '... got the right amount'); |
97 | |
98 | ok($hundred->greater_than($fifty), '... 100 gt 50'); |
99 | ok($hundred->greater_than_or_equal_to($fifty), '... 100 ge 50'); |
100 | ok(!$hundred->less_than($fifty), '... !100 lt 50'); |
101 | ok(!$hundred->less_than_or_equal_to($fifty), '... !100 le 50'); |
102 | ok(!$hundred->equal_to($fifty), '... !100 eq 50'); |
103 | ok($hundred->not_equal_to($fifty), '... 100 ne 50'); |
104 | |
105 | ok(!$fifty->greater_than($hundred), '... !50 gt 100'); |
106 | ok(!$fifty->greater_than_or_equal_to($hundred), '... !50 ge 100'); |
107 | ok($fifty->less_than($hundred), '... 50 lt 100'); |
108 | ok($fifty->less_than_or_equal_to($hundred), '... 50 le 100'); |
109 | ok(!$fifty->equal_to($hundred), '... !50 eq 100'); |
110 | ok($fifty->not_equal_to($hundred), '... 50 ne 100'); |
111 | |
112 | ok(!$fifty->greater_than($fifty), '... !50 gt 50'); |
113 | ok($fifty->greater_than_or_equal_to($fifty), '... !50 ge 50'); |
114 | ok(!$fifty->less_than($fifty), '... 50 lt 50'); |
115 | ok($fifty->less_than_or_equal_to($fifty), '... 50 le 50'); |
116 | ok($fifty->equal_to($fifty), '... 50 eq 50'); |
117 | ok(!$fifty->not_equal_to($fifty), '... !50 ne 50'); |
118 | |
119 | ## ... check some meta-stuff |
120 | |
121 | # Eq |
122 | |
123 | my $eq_meta = Eq->meta; |
124 | isa_ok($eq_meta, 'Moose::Meta::Role'); |
125 | |
126 | foreach my $method_name (qw( |
127 | equal_to not_equal_to |
128 | )) { |
129 | ok($eq_meta->has_method($method_name), '... Eq has_method ' . $method_name); |
130 | } |
131 | |
132 | # Ord |
133 | |
134 | my $comparable_meta = Ord->meta; |
135 | isa_ok($comparable_meta, 'Moose::Meta::Role'); |
136 | |
137 | ok($comparable_meta->does_role('Eq'), '... Ord does Eq'); |
138 | |
139 | foreach my $method_name (qw( |
140 | equal_to not_equal_to |
141 | compare |
142 | greater_than greater_than_or_equal_to |
143 | less_than less_than_or_equal_to |
144 | )) { |
145 | ok($comparable_meta->has_method($method_name), '... Ord has_method ' . $method_name); |
146 | } |
147 | |
148 | # US::Currency |
149 | |
150 | my $currency_meta = US::Currency->meta; |
151 | isa_ok($currency_meta, 'Moose::Meta::Class'); |
152 | |
153 | ok($currency_meta->does_role('Ord'), '... US::Currency does Ord'); |
154 | ok($currency_meta->does_role('Eq'), '... US::Currency does Eq'); |
155 | |
156 | foreach my $method_name (qw( |
157 | amount |
158 | equal_to not_equal_to |
159 | compare |
160 | greater_than greater_than_or_equal_to |
161 | less_than less_than_or_equal_to |
162 | )) { |
163 | ok($currency_meta->has_method($method_name), '... US::Currency has_method ' . $method_name); |
164 | } |
165 | |