Fix a test for ancient perls
[gitmo/Mouse.git] / t / 000_recipes / moose_cookbook_roles_recipe1.t
CommitLineData
f9aca0f3 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' );
88{
89local $TODO = 'UNIVERSAL::DOES is not supported';
4dd75d57 90ok( eval{ $hundred->DOES("US::Currency") }, "UNIVERSAL::DOES for class" );
91ok( eval{ $hundred->DOES("Comparable") }, "UNIVERSAL::DOES for role" );
f9aca0f3 92}
93can_ok( $hundred, 'amount' );
94is( $hundred->amount, 100, '... got the right amount' );
95
96can_ok( $hundred, 'to_string' );
97is( $hundred->to_string, '$100.00 USD',
98 '... got the right stringified value' );
99
100ok( $hundred->does('Comparable'), '... US::Currency does Comparable' );
101ok( $hundred->does('Eq'), '... US::Currency does Eq' );
102ok( $hundred->does('Printable'), '... US::Currency does Printable' );
103
104my $fifty = US::Currency->new( amount => 50.00 );
105isa_ok( $fifty, 'US::Currency' );
106
107can_ok( $fifty, 'amount' );
108is( $fifty->amount, 50, '... got the right amount' );
109
110can_ok( $fifty, 'to_string' );
111is( $fifty->to_string, '$50.00 USD', '... got the right stringified value' );
112
113ok( $hundred->greater_than($fifty), '... 100 gt 50' );
114ok( $hundred->greater_than_or_equal_to($fifty), '... 100 ge 50' );
115ok( !$hundred->less_than($fifty), '... !100 lt 50' );
116ok( !$hundred->less_than_or_equal_to($fifty), '... !100 le 50' );
117ok( !$hundred->equal_to($fifty), '... !100 eq 50' );
118ok( $hundred->not_equal_to($fifty), '... 100 ne 50' );
119
120ok( !$fifty->greater_than($hundred), '... !50 gt 100' );
121ok( !$fifty->greater_than_or_equal_to($hundred), '... !50 ge 100' );
122ok( $fifty->less_than($hundred), '... 50 lt 100' );
123ok( $fifty->less_than_or_equal_to($hundred), '... 50 le 100' );
124ok( !$fifty->equal_to($hundred), '... !50 eq 100' );
125ok( $fifty->not_equal_to($hundred), '... 50 ne 100' );
126
127ok( !$fifty->greater_than($fifty), '... !50 gt 50' );
128ok( $fifty->greater_than_or_equal_to($fifty), '... !50 ge 50' );
129ok( !$fifty->less_than($fifty), '... 50 lt 50' );
130ok( $fifty->less_than_or_equal_to($fifty), '... 50 le 50' );
131ok( $fifty->equal_to($fifty), '... 50 eq 50' );
132ok( !$fifty->not_equal_to($fifty), '... !50 ne 50' );
133
134## ... check some meta-stuff
135
136# Eq
137
138my $eq_meta = Eq->meta;
139isa_ok( $eq_meta, 'Mouse::Meta::Role' );
140
141ok( $eq_meta->has_method('not_equal_to'), '... Eq has_method not_equal_to' );
142ok( $eq_meta->requires_method('equal_to'),
143 '... Eq requires_method not_equal_to' );
144
145# Comparable
146
147my $comparable_meta = Comparable->meta;
148isa_ok( $comparable_meta, 'Mouse::Meta::Role' );
149
150ok( $comparable_meta->does_role('Eq'), '... Comparable does Eq' );
151
152foreach 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
163ok( $comparable_meta->requires_method('compare'),
164 '... Comparable requires_method compare' );
165
166# Printable
167
168my $printable_meta = Printable->meta;
169isa_ok( $printable_meta, 'Mouse::Meta::Role' );
170
171ok( $printable_meta->requires_method('to_string'),
172 '... Printable requires_method to_string' );
173
174# US::Currency
175
176my $currency_meta = US::Currency->meta;
177isa_ok( $currency_meta, 'Mouse::Meta::Class' );
178
179ok( $currency_meta->does_role('Comparable'),
180 '... US::Currency does Comparable' );
181ok( $currency_meta->does_role('Eq'), '... US::Currency does Eq' );
182ok( $currency_meta->does_role('Printable'),
183 '... US::Currency does Printable' );
184
185foreach 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
2031;