Commit | Line | Data |
b841b2a3 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
7ff56534 |
6 | use Test::More tests => 63; |
b841b2a3 |
7 | use Test::Exception; |
8 | |
7ff56534 |
9 | |
e9bb8a31 |
10 | |
a7d0cd00 |
11 | ## Roles |
12 | |
78cd1d3b |
13 | { |
446e850f |
14 | package Eq; |
a7d0cd00 |
15 | use Moose::Role; |
a7d0cd00 |
16 | |
446e850f |
17 | requires 'equal_to'; |
a7d0cd00 |
18 | |
446e850f |
19 | sub not_equal_to { |
20 | my ($self, $other) = @_; |
9e93dd19 |
21 | not $self->equal_to($other); |
446e850f |
22 | } |
a7d0cd00 |
23 | |
9e93dd19 |
24 | package Comparable; |
a7d0cd00 |
25 | use Moose::Role; |
446e850f |
26 | |
27 | with 'Eq'; |
28 | |
29 | requires 'compare'; |
30 | |
31 | sub equal_to { |
32 | my ($self, $other) = @_; |
33 | $self->compare($other) == 0; |
34 | } |
35 | |
36 | sub greater_than { |
37 | my ($self, $other) = @_; |
38 | $self->compare($other) == 1; |
39 | } |
40 | |
41 | sub less_than { |
42 | my ($self, $other) = @_; |
43 | $self->compare($other) == -1; |
44 | } |
45 | |
46 | sub greater_than_or_equal_to { |
47 | my ($self, $other) = @_; |
48 | $self->greater_than($other) || $self->equal_to($other); |
49 | } |
50 | |
51 | sub less_than_or_equal_to { |
52 | my ($self, $other) = @_; |
53 | $self->less_than($other) || $self->equal_to($other); |
9e93dd19 |
54 | } |
55 | |
56 | package Printable; |
9e93dd19 |
57 | use Moose::Role; |
58 | |
59 | requires 'to_string'; |
a7d0cd00 |
60 | } |
61 | |
446e850f |
62 | ## Classes |
3824830b |
63 | |
a7d0cd00 |
64 | { |
446e850f |
65 | package US::Currency; |
3824830b |
66 | use Moose; |
446e850f |
67 | |
9e93dd19 |
68 | with 'Comparable', 'Printable'; |
446e850f |
69 | |
81dc201f |
70 | has 'amount' => (is => 'rw', isa => 'Num', default => 0); |
446e850f |
71 | |
72 | sub compare { |
73 | my ($self, $other) = @_; |
74 | $self->amount <=> $other->amount; |
75 | } |
9e93dd19 |
76 | |
77 | sub to_string { |
78 | my $self = shift; |
79 | sprintf '$%0.2f USD' => $self->amount |
80 | } |
5cf3dbcf |
81 | |
5a3217de |
82 | __PACKAGE__->meta->make_immutable(debug => 0); |
446e850f |
83 | } |
3824830b |
84 | |
9e93dd19 |
85 | ok(US::Currency->does('Comparable'), '... US::Currency does Comparable'); |
446e850f |
86 | ok(US::Currency->does('Eq'), '... US::Currency does Eq'); |
9e93dd19 |
87 | ok(US::Currency->does('Printable'), '... US::Currency does Printable'); |
3824830b |
88 | |
446e850f |
89 | my $hundred = US::Currency->new(amount => 100.00); |
90 | isa_ok($hundred, 'US::Currency'); |
3824830b |
91 | |
d0e9d54e |
92 | ok( $hundred->DOES("US::Currency"), "UNIVERSAL::DOES for class" ); |
93 | ok( $hundred->DOES("Comparable"), "UNIVERSAL::DOES for role" ); |
94 | |
446e850f |
95 | can_ok($hundred, 'amount'); |
96 | is($hundred->amount, 100, '... got the right amount'); |
3824830b |
97 | |
9e93dd19 |
98 | can_ok($hundred, 'to_string'); |
99 | is($hundred->to_string, '$100.00 USD', '... got the right stringified value'); |
100 | |
101 | ok($hundred->does('Comparable'), '... US::Currency does Comparable'); |
446e850f |
102 | ok($hundred->does('Eq'), '... US::Currency does Eq'); |
9e93dd19 |
103 | ok($hundred->does('Printable'), '... US::Currency does Printable'); |
3824830b |
104 | |
446e850f |
105 | my $fifty = US::Currency->new(amount => 50.00); |
106 | isa_ok($fifty, 'US::Currency'); |
3824830b |
107 | |
446e850f |
108 | can_ok($fifty, 'amount'); |
109 | is($fifty->amount, 50, '... got the right amount'); |
3824830b |
110 | |
9e93dd19 |
111 | can_ok($fifty, 'to_string'); |
112 | is($fifty->to_string, '$50.00 USD', '... got the right stringified value'); |
113 | |
446e850f |
114 | ok($hundred->greater_than($fifty), '... 100 gt 50'); |
115 | ok($hundred->greater_than_or_equal_to($fifty), '... 100 ge 50'); |
116 | ok(!$hundred->less_than($fifty), '... !100 lt 50'); |
117 | ok(!$hundred->less_than_or_equal_to($fifty), '... !100 le 50'); |
118 | ok(!$hundred->equal_to($fifty), '... !100 eq 50'); |
119 | ok($hundred->not_equal_to($fifty), '... 100 ne 50'); |
3824830b |
120 | |
446e850f |
121 | ok(!$fifty->greater_than($hundred), '... !50 gt 100'); |
122 | ok(!$fifty->greater_than_or_equal_to($hundred), '... !50 ge 100'); |
123 | ok($fifty->less_than($hundred), '... 50 lt 100'); |
124 | ok($fifty->less_than_or_equal_to($hundred), '... 50 le 100'); |
125 | ok(!$fifty->equal_to($hundred), '... !50 eq 100'); |
126 | ok($fifty->not_equal_to($hundred), '... 50 ne 100'); |
3824830b |
127 | |
446e850f |
128 | ok(!$fifty->greater_than($fifty), '... !50 gt 50'); |
129 | ok($fifty->greater_than_or_equal_to($fifty), '... !50 ge 50'); |
130 | ok(!$fifty->less_than($fifty), '... 50 lt 50'); |
131 | ok($fifty->less_than_or_equal_to($fifty), '... 50 le 50'); |
132 | ok($fifty->equal_to($fifty), '... 50 eq 50'); |
133 | ok(!$fifty->not_equal_to($fifty), '... !50 ne 50'); |
a7d0cd00 |
134 | |
446e850f |
135 | ## ... check some meta-stuff |
a7d0cd00 |
136 | |
446e850f |
137 | # Eq |
ef333f17 |
138 | |
446e850f |
139 | my $eq_meta = Eq->meta; |
140 | isa_ok($eq_meta, 'Moose::Meta::Role'); |
a7d0cd00 |
141 | |
446e850f |
142 | ok($eq_meta->has_method('not_equal_to'), '... Eq has_method not_equal_to'); |
143 | ok($eq_meta->requires_method('equal_to'), '... Eq requires_method not_equal_to'); |
a7d0cd00 |
144 | |
9e93dd19 |
145 | # Comparable |
ef333f17 |
146 | |
9e93dd19 |
147 | my $comparable_meta = Comparable->meta; |
148 | isa_ok($comparable_meta, 'Moose::Meta::Role'); |
a7d0cd00 |
149 | |
9e93dd19 |
150 | ok($comparable_meta->does_role('Eq'), '... Comparable does Eq'); |
a7d0cd00 |
151 | |
446e850f |
152 | foreach my $method_name (qw( |
153 | equal_to not_equal_to |
154 | greater_than greater_than_or_equal_to |
155 | less_than less_than_or_equal_to |
156 | )) { |
9e93dd19 |
157 | ok($comparable_meta->has_method($method_name), '... Comparable has_method ' . $method_name); |
446e850f |
158 | } |
a7d0cd00 |
159 | |
9e93dd19 |
160 | ok($comparable_meta->requires_method('compare'), '... Comparable requires_method compare'); |
161 | |
162 | # Printable |
163 | |
164 | my $printable_meta = Printable->meta; |
165 | isa_ok($printable_meta, 'Moose::Meta::Role'); |
166 | |
167 | ok($printable_meta->requires_method('to_string'), '... Printable requires_method to_string'); |
ef333f17 |
168 | |
446e850f |
169 | # US::Currency |
a7d0cd00 |
170 | |
446e850f |
171 | my $currency_meta = US::Currency->meta; |
172 | isa_ok($currency_meta, 'Moose::Meta::Class'); |
a7d0cd00 |
173 | |
9e93dd19 |
174 | ok($currency_meta->does_role('Comparable'), '... US::Currency does Comparable'); |
446e850f |
175 | ok($currency_meta->does_role('Eq'), '... US::Currency does Eq'); |
9e93dd19 |
176 | ok($currency_meta->does_role('Printable'), '... US::Currency does Printable'); |
ef333f17 |
177 | |
446e850f |
178 | foreach my $method_name (qw( |
179 | amount |
180 | equal_to not_equal_to |
181 | compare |
182 | greater_than greater_than_or_equal_to |
9e93dd19 |
183 | less_than less_than_or_equal_to |
184 | to_string |
446e850f |
185 | )) { |
186 | ok($currency_meta->has_method($method_name), '... US::Currency has_method ' . $method_name); |
187 | } |
a7d0cd00 |
188 | |