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