#!/usr/bin/perl -w use strict; use Test::More 'no_plan'; use Test::Fatal; $| = 1; # =begin testing SETUP { package Eq; use Moose::Role; requires 'equal_to'; sub not_equal_to { my ( $self, $other ) = @_; not $self->equal_to($other); } package Comparable; use Moose::Role; with 'Eq'; requires 'compare'; sub equal_to { my ( $self, $other ) = @_; $self->compare($other) == 0; } sub greater_than { my ( $self, $other ) = @_; $self->compare($other) == 1; } sub less_than { my ( $self, $other ) = @_; $self->compare($other) == -1; } sub greater_than_or_equal_to { my ( $self, $other ) = @_; $self->greater_than($other) || $self->equal_to($other); } sub less_than_or_equal_to { my ( $self, $other ) = @_; $self->less_than($other) || $self->equal_to($other); } package Printable; use Moose::Role; requires 'to_string'; package US::Currency; use Moose; with 'Comparable', 'Printable'; has 'amount' => ( is => 'rw', isa => 'Num', default => 0 ); sub compare { my ( $self, $other ) = @_; $self->amount <=> $other->amount; } sub to_string { my $self = shift; sprintf '$%0.2f USD' => $self->amount; } } # =begin testing { ok( US::Currency->does('Comparable'), '... US::Currency does Comparable' ); ok( US::Currency->does('Eq'), '... US::Currency does Eq' ); ok( US::Currency->does('Printable'), '... US::Currency does Printable' ); my $hundred = US::Currency->new( amount => 100.00 ); isa_ok( $hundred, 'US::Currency' ); ok( $hundred->DOES("US::Currency"), "UNIVERSAL::DOES for class" ); ok( $hundred->DOES("Comparable"), "UNIVERSAL::DOES for role" ); can_ok( $hundred, 'amount' ); is( $hundred->amount, 100, '... got the right amount' ); can_ok( $hundred, 'to_string' ); is( $hundred->to_string, '$100.00 USD', '... got the right stringified value' ); ok( $hundred->does('Comparable'), '... US::Currency does Comparable' ); ok( $hundred->does('Eq'), '... US::Currency does Eq' ); ok( $hundred->does('Printable'), '... US::Currency does Printable' ); my $fifty = US::Currency->new( amount => 50.00 ); isa_ok( $fifty, 'US::Currency' ); can_ok( $fifty, 'amount' ); is( $fifty->amount, 50, '... got the right amount' ); can_ok( $fifty, 'to_string' ); is( $fifty->to_string, '$50.00 USD', '... got the right stringified value' ); ok( $hundred->greater_than($fifty), '... 100 gt 50' ); ok( $hundred->greater_than_or_equal_to($fifty), '... 100 ge 50' ); ok( !$hundred->less_than($fifty), '... !100 lt 50' ); ok( !$hundred->less_than_or_equal_to($fifty), '... !100 le 50' ); ok( !$hundred->equal_to($fifty), '... !100 eq 50' ); ok( $hundred->not_equal_to($fifty), '... 100 ne 50' ); ok( !$fifty->greater_than($hundred), '... !50 gt 100' ); ok( !$fifty->greater_than_or_equal_to($hundred), '... !50 ge 100' ); ok( $fifty->less_than($hundred), '... 50 lt 100' ); ok( $fifty->less_than_or_equal_to($hundred), '... 50 le 100' ); ok( !$fifty->equal_to($hundred), '... !50 eq 100' ); ok( $fifty->not_equal_to($hundred), '... 50 ne 100' ); ok( !$fifty->greater_than($fifty), '... !50 gt 50' ); ok( $fifty->greater_than_or_equal_to($fifty), '... !50 ge 50' ); ok( !$fifty->less_than($fifty), '... 50 lt 50' ); ok( $fifty->less_than_or_equal_to($fifty), '... 50 le 50' ); ok( $fifty->equal_to($fifty), '... 50 eq 50' ); ok( !$fifty->not_equal_to($fifty), '... !50 ne 50' ); ## ... check some meta-stuff # Eq my $eq_meta = Eq->meta; isa_ok( $eq_meta, 'Moose::Meta::Role' ); ok( $eq_meta->has_method('not_equal_to'), '... Eq has_method not_equal_to' ); ok( $eq_meta->requires_method('equal_to'), '... Eq requires_method not_equal_to' ); # Comparable my $comparable_meta = Comparable->meta; isa_ok( $comparable_meta, 'Moose::Meta::Role' ); ok( $comparable_meta->does_role('Eq'), '... Comparable does Eq' ); foreach my $method_name ( qw( equal_to not_equal_to greater_than greater_than_or_equal_to less_than less_than_or_equal_to ) ) { ok( $comparable_meta->has_method($method_name), '... Comparable has_method ' . $method_name ); } ok( $comparable_meta->requires_method('compare'), '... Comparable requires_method compare' ); # Printable my $printable_meta = Printable->meta; isa_ok( $printable_meta, 'Moose::Meta::Role' ); ok( $printable_meta->requires_method('to_string'), '... Printable requires_method to_string' ); # US::Currency my $currency_meta = US::Currency->meta; isa_ok( $currency_meta, 'Moose::Meta::Class' ); ok( $currency_meta->does_role('Comparable'), '... US::Currency does Comparable' ); ok( $currency_meta->does_role('Eq'), '... US::Currency does Eq' ); ok( $currency_meta->does_role('Printable'), '... US::Currency does Printable' ); foreach my $method_name ( qw( amount equal_to not_equal_to compare greater_than greater_than_or_equal_to less_than less_than_or_equal_to to_string ) ) { ok( $currency_meta->has_method($method_name), '... US::Currency has_method ' . $method_name ); } } 1;