t/000_recipes/roles/001_roles.t

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