t/000_recipes/roles/001_roles.t

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