1#!/usr/bin/perl -w
2
3use strict;
4use Test::More 'no_plan';
5use 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{
82ok( US::Currency->does('Comparable'), '... US::Currency does Comparable' );
83ok( US::Currency->does('Eq'),         '... US::Currency does Eq' );
84ok( US::Currency->does('Printable'),  '... US::Currency does Printable' );
85
86my $hundred = US::Currency->new( amount => 100.00 );
87isa_ok( $hundred, 'US::Currency' );
88ok( $hundred->DOES("US::Currency"), "UNIVERSAL::DOES for class" );
89ok( $hundred->DOES("Comparable"),   "UNIVERSAL::DOES for role" );
90can_ok( $hundred, 'amount' );
91is( $hundred->amount, 100, '... got the right amount' );
92
93can_ok( $hundred, 'to_string' );
94is( $hundred->to_string, '$100.00 USD',
95    '... got the right stringified value' );
96
97ok( $hundred->does('Comparable'), '... US::Currency does Comparable' );
98ok( $hundred->does('Eq'),         '... US::Currency does Eq' );
99ok( $hundred->does('Printable'),  '... US::Currency does Printable' );
100
101my $fifty = US::Currency->new( amount => 50.00 );
102isa_ok( $fifty, 'US::Currency' );
103
104can_ok( $fifty, 'amount' );
105is( $fifty->amount, 50, '... got the right amount' );
106
107can_ok( $fifty, 'to_string' );
108is( $fifty->to_string, '$50.00 USD', '... got the right stringified value' );
109
110ok( $hundred->greater_than($fifty),             '... 100 gt 50' );
111ok( $hundred->greater_than_or_equal_to($fifty), '... 100 ge 50' );
112ok( !$hundred->less_than($fifty),               '... !100 lt 50' );
113ok( !$hundred->less_than_or_equal_to($fifty),   '... !100 le 50' );
114ok( !$hundred->equal_to($fifty),                '... !100 eq 50' );
115ok( $hundred->not_equal_to($fifty),             '... 100 ne 50' );
116
117ok( !$fifty->greater_than($hundred),             '... !50 gt 100' );
118ok( !$fifty->greater_than_or_equal_to($hundred), '... !50 ge 100' );
119ok( $fifty->less_than($hundred),                 '... 50 lt 100' );
120ok( $fifty->less_than_or_equal_to($hundred),     '... 50 le 100' );
121ok( !$fifty->equal_to($hundred),                 '... !50 eq 100' );
122ok( $fifty->not_equal_to($hundred),              '... 50 ne 100' );
123
124ok( !$fifty->greater_than($fifty),            '... !50 gt 50' );
125ok( $fifty->greater_than_or_equal_to($fifty), '... !50 ge 50' );
126ok( !$fifty->less_than($fifty),               '... 50 lt 50' );
127ok( $fifty->less_than_or_equal_to($fifty),    '... 50 le 50' );
128ok( $fifty->equal_to($fifty),                 '... 50 eq 50' );
129ok( !$fifty->not_equal_to($fifty),            '... !50 ne 50' );
130
131## ... check some meta-stuff
132
133# Eq
134
135my $eq_meta = Eq->meta;
136isa_ok( $eq_meta, 'Mouse::Meta::Role' );
137
138ok( $eq_meta->has_method('not_equal_to'), '... Eq has_method not_equal_to' );
139ok( $eq_meta->requires_method('equal_to'),
140    '... Eq requires_method not_equal_to' );
141
142# Comparable
143
144my $comparable_meta = Comparable->meta;
145isa_ok( $comparable_meta, 'Mouse::Meta::Role' );
146
147ok( $comparable_meta->does_role('Eq'), '... Comparable does Eq' );
148
149foreach my $method_name (
150    qw(
151    equal_to not_equal_to
152    greater_than greater_than_or_equal_to
153    less_than less_than_or_equal_to
154    )
155    ) {
156    ok( $comparable_meta->has_method($method_name),
157        '... Comparable has_method ' . $method_name );
158}
159
160ok( $comparable_meta->requires_method('compare'),
161    '... Comparable requires_method compare' );
162
163# Printable
164
165my $printable_meta = Printable->meta;
166isa_ok( $printable_meta, 'Mouse::Meta::Role' );
167
168ok( $printable_meta->requires_method('to_string'),
169    '... Printable requires_method to_string' );
170
171# US::Currency
172
173my $currency_meta = US::Currency->meta;
174isa_ok( $currency_meta, 'Mouse::Meta::Class' );
175
176ok( $currency_meta->does_role('Comparable'),
177    '... US::Currency does Comparable' );
178ok( $currency_meta->does_role('Eq'), '... US::Currency does Eq' );
179ok( $currency_meta->does_role('Printable'),
180    '... US::Currency does Printable' );
181
182foreach my $method_name (
183    qw(
184    amount
185    equal_to not_equal_to
186    compare
187    greater_than greater_than_or_equal_to
188    less_than less_than_or_equal_to
189    to_string
190    )
191    ) {
192    ok( $currency_meta->has_method($method_name),
193        '... US::Currency has_method ' . $method_name );
194}
195}
196
197
198
199
2001;
201