t/bugs/instance_application_role_args.t

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   5
   6 {
   7     package Point;
   8     use Moose;
   9
  10     with qw/DoesNegated DoesTranspose/;
  11
  12     has x => ( isa => 'Int', is => 'rw' );
  13     has y => ( isa => 'Int', is => 'rw' );
  14
  15     sub inspect { [$_[0]->x, $_[0]->y] }
  16
  17     no Moose;
  18 }
  19
  20 {
  21     package DoesNegated;
  22     use Moose::Role;
  23
  24     sub negated {
  25         my $self = shift;
  26         $self->new( x => -$self->x, y => -$self->y );
  27     }
  28
  29     no Moose::Role;
  30 }
  31
  32 {
  33     package DoesTranspose;
  34     use Moose::Role;
  35
  36     sub transpose {
  37         my $self = shift;
  38         $self->new( x => $self->y, y => $self->x );
  39     }
  40
  41     no Moose::Role;
  42 }
  43
  44 my $p = Point->new( x => 4, y => 3 );
  45
  46 DoesTranspose->meta->apply( $p, -alias => { transpose => 'negated' } );
  47
  48 is_deeply($p->negated->inspect, [3, 4]);
  49 is_deeply($p->transpose->inspect, [3, 4]);
  50
  51 done_testing;