t/006_basic.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 52;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     use_ok('Moose');
  11 }
  12
  13 ## Roles
  14
  15 {
  16     package Eq;
  17     use strict;
  18     use warnings;
  19     use Moose::Role;
  20
  21     requires 'equal_to';
  22
  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
  35     requires 'compare';
  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
  81 ok(US::Currency->does('Ord'), '... US::Currency does Ord');
  82 ok(US::Currency->does('Eq'), '... US::Currency does Eq');
  83
  84 my $hundred = US::Currency->new(amount => 100.00);
  85 isa_ok($hundred, 'US::Currency');
  86
  87 can_ok($hundred, 'amount');
  88 is($hundred->amount, 100, '... got the right amount');
  89
  90 ok($hundred->does('Ord'), '... US::Currency does Ord');
  91 ok($hundred->does('Eq'), '... US::Currency does Eq');
  92
  93 my $fifty = US::Currency->new(amount => 50.00);
  94 isa_ok($fifty, 'US::Currency');
  95
  96 can_ok($fifty, 'amount');
  97 is($fifty->amount, 50, '... got the right amount');
  98
  99 ok($hundred->greater_than($fifty),             '... 100 gt 50');
 100 ok($hundred->greater_than_or_equal_to($fifty), '... 100 ge 50');
 101 ok(!$hundred->less_than($fifty),               '... !100 lt 50');
 102 ok(!$hundred->less_than_or_equal_to($fifty),   '... !100 le 50');
 103 ok(!$hundred->equal_to($fifty),                '... !100 eq 50');
 104 ok($hundred->not_equal_to($fifty),             '... 100 ne 50');
 105
 106 ok(!$fifty->greater_than($hundred),             '... !50 gt 100');
 107 ok(!$fifty->greater_than_or_equal_to($hundred), '... !50 ge 100');
 108 ok($fifty->less_than($hundred),                 '... 50 lt 100');
 109 ok($fifty->less_than_or_equal_to($hundred),     '... 50 le 100');
 110 ok(!$fifty->equal_to($hundred),                 '... !50 eq 100');
 111 ok($fifty->not_equal_to($hundred),              '... 50 ne 100');
 112
 113 ok(!$fifty->greater_than($fifty),            '... !50 gt 50');
 114 ok($fifty->greater_than_or_equal_to($fifty), '... !50 ge 50');
 115 ok(!$fifty->less_than($fifty),               '... 50 lt 50');
 116 ok($fifty->less_than_or_equal_to($fifty),    '... 50 le 50');
 117 ok($fifty->equal_to($fifty),                 '... 50 eq 50');
 118 ok(!$fifty->not_equal_to($fifty),            '... !50 ne 50');
 119
 120 ## ... check some meta-stuff
 121
 122 # Eq
 123
 124 my $eq_meta = Eq->meta;
 125 isa_ok($eq_meta, 'Moose::Meta::Role');
 126
 127 ok($eq_meta->has_method('not_equal_to'), '... Eq has_method not_equal_to');
 128 ok($eq_meta->requires_method('equal_to'), '... Eq requires_method not_equal_to');
 129
 130 # Ord
 131
 132 my $ord_meta = Ord->meta;
 133 isa_ok($ord_meta, 'Moose::Meta::Role');
 134
 135 ok($ord_meta->does_role('Eq'), '... Ord does Eq');
 136
 137 foreach my $method_name (qw(
 138                         equal_to not_equal_to
 139                         greater_than greater_than_or_equal_to
 140                         less_than less_than_or_equal_to
 141                         )) {
 142     ok($ord_meta->has_method($method_name), '... Ord has_method ' . $method_name);
 143 }
 144
 145 ok($ord_meta->requires_method('compare'), '... Ord requires_method compare');
 146
 147 # US::Currency
 148
 149 my $currency_meta = US::Currency->meta;
 150 isa_ok($currency_meta, 'Moose::Meta::Class');
 151
 152 ok($currency_meta->does_role('Ord'), '... US::Currency does Ord');
 153 ok($currency_meta->does_role('Eq'), '... US::Currency does Eq');
 154
 155 foreach 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