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