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' ); 88ok( $hundred->DOES("US::Currency"), "UNIVERSAL::DOES for class" ); 89ok( $hundred->DOES("Comparable"), "UNIVERSAL::DOES for role" ); 90can_ok( $hundred, 'amount' ); 91is( $hundred->amount, 100, '... got the right amount' ); 92 93can_ok( $hundred, 'to_string' ); 94is( $hundred->to_string, '$100.00 USD', 95 '... got the right stringified value' ); 96 97ok( $hundred->does('Comparable'), '... US::Currency does Comparable' ); 98ok( $hundred->does('Eq'), '... US::Currency does Eq' ); 99ok( $hundred->does('Printable'), '... US::Currency does Printable' ); 100 101my $fifty = US::Currency->new( amount => 50.00 ); 102isa_ok( $fifty, 'US::Currency' ); 103 104can_ok( $fifty, 'amount' ); 105is( $fifty->amount, 50, '... got the right amount' ); 106 107can_ok( $fifty, 'to_string' ); 108is( $fifty->to_string, '$50.00 USD', '... got the right stringified value' ); 109 110ok( $hundred->greater_than($fifty), '... 100 gt 50' ); 111ok( $hundred->greater_than_or_equal_to($fifty), '... 100 ge 50' ); 112ok( !$hundred->less_than($fifty), '... !100 lt 50' ); 113ok( !$hundred->less_than_or_equal_to($fifty), '... !100 le 50' ); 114ok( !$hundred->equal_to($fifty), '... !100 eq 50' ); 115ok( $hundred->not_equal_to($fifty), '... 100 ne 50' ); 116 117ok( !$fifty->greater_than($hundred), '... !50 gt 100' ); 118ok( !$fifty->greater_than_or_equal_to($hundred), '... !50 ge 100' ); 119ok( $fifty->less_than($hundred), '... 50 lt 100' ); 120ok( $fifty->less_than_or_equal_to($hundred), '... 50 le 100' ); 121ok( !$fifty->equal_to($hundred), '... !50 eq 100' ); 122ok( $fifty->not_equal_to($hundred), '... 50 ne 100' ); 123 124ok( !$fifty->greater_than($fifty), '... !50 gt 50' ); 125ok( $fifty->greater_than_or_equal_to($fifty), '... !50 ge 50' ); 126ok( !$fifty->less_than($fifty), '... 50 lt 50' ); 127ok( $fifty->less_than_or_equal_to($fifty), '... 50 le 50' ); 128ok( $fifty->equal_to($fifty), '... 50 eq 50' ); 129ok( !$fifty->not_equal_to($fifty), '... !50 ne 50' ); 130 131## ... check some meta-stuff 132 133# Eq 134 135my $eq_meta = Eq->meta; 136isa_ok( $eq_meta, 'Mouse::Meta::Role' ); 137 138ok( $eq_meta->has_method('not_equal_to'), '... Eq has_method not_equal_to' ); 139ok( $eq_meta->requires_method('equal_to'), 140 '... Eq requires_method not_equal_to' ); 141 142# Comparable 143 144my $comparable_meta = Comparable->meta; 145isa_ok( $comparable_meta, 'Mouse::Meta::Role' ); 146 147ok( $comparable_meta->does_role('Eq'), '... Comparable does Eq' ); 148 149foreach my $method_name ( 150 qw( 151 equal_to not_equal_to 152 greater_than greater_than_or_equal_to 153 less_than less_than_or_equal_to 154 ) 155 ) { 156 ok( $comparable_meta->has_method($method_name), 157 '... Comparable has_method ' . $method_name ); 158} 159 160ok( $comparable_meta->requires_method('compare'), 161 '... Comparable requires_method compare' ); 162 163# Printable 164 165my $printable_meta = Printable->meta; 166isa_ok( $printable_meta, 'Mouse::Meta::Role' ); 167 168ok( $printable_meta->requires_method('to_string'), 169 '... Printable requires_method to_string' ); 170 171# US::Currency 172 173my $currency_meta = US::Currency->meta; 174isa_ok( $currency_meta, 'Mouse::Meta::Class' ); 175 176ok( $currency_meta->does_role('Comparable'), 177 '... US::Currency does Comparable' ); 178ok( $currency_meta->does_role('Eq'), '... US::Currency does Eq' ); 179ok( $currency_meta->does_role('Printable'), 180 '... US::Currency does Printable' ); 181 182foreach my $method_name ( 183 qw( 184 amount 185 equal_to not_equal_to 186 compare 187 greater_than greater_than_or_equal_to 188 less_than less_than_or_equal_to 189 to_string 190 ) 191 ) { 192 ok( $currency_meta->has_method($method_name), 193 '... US::Currency has_method ' . $method_name ); 194} 195} 196 197 198 199 2001; 201