Beta Shell v2.0

File Manager

Name	Size	Perms	Modified	Actions
[ .. / .. ]
basics_bankaccount_methodmodifiersandsubclassing.t	3.71 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
basics_binarytree_attributefeatures.t	3.83 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
basics_company_subtypes.t	9.54 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
basics_datetime_extendingnonmooseparent.t	1.16 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
basics_document_augmentandinner.t	1.45 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
basics_genome_overloadingsubtypesandcoercion.t	5.2 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
basics_http_subtypesandcoercion.t	3.24 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
basics_point_attributesandsubclassing.t	5.35 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
extending_debugging_baseclassrole.t	755 B	-rw-r--r--	2019-10-21 09:36:33	Edit Del
extending_mooseish_moosesugar.t	983 B	-rw-r--r--	2019-10-21 09:36:33	Edit Del
legacy_debugging_baseclassreplacement.t	953 B	-rw-r--r--	2019-10-21 09:36:33	Edit Del
legacy_labeled_attributemetaclass.t	1.52 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
meta_globref_instancemetaclass.t	3.23 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
meta_labeled_attributetrait.t	1.43 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
meta_privateorpublic_methodmetaclass.t	1.93 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
meta_table_metaclasstrait.t	798 B	-rw-r--r--	2019-10-21 09:36:33	Edit Del
roles_applicationtoinstance.t	1.73 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
roles_comparable_codereuse.t	5.16 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del
roles_restartable_advancedcomposition.t	2 KB	-rw-r--r--	2019-10-21 09:36:33	Edit Del

Editing: roles_comparable_codereuse.t (5.16 KB)

#!/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;