t/attributes/trigger_and_coerce.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7
   8
   9 {
  10
  11     package Fake::DateTime;
  12     use Moose;
  13
  14     has 'string_repr' => ( is => 'ro' );
  15
  16     package Mortgage;
  17     use Moose;
  18     use Moose::Util::TypeConstraints;
  19
  20     coerce 'Fake::DateTime' => from 'Str' =>
  21         via { Fake::DateTime->new( string_repr => $_ ) };
  22
  23     has 'closing_date' => (
  24         is      => 'rw',
  25         isa     => 'Fake::DateTime',
  26         coerce  => 1,
  27         trigger => sub {
  28             my ( $self, $val ) = @_;
  29             ::pass('... trigger is being called');
  30             ::isa_ok( $self->closing_date, 'Fake::DateTime' );
  31             ::isa_ok( $val,                'Fake::DateTime' );
  32         }
  33     );
  34 }
  35
  36 {
  37     my $mtg = Mortgage->new( closing_date => 'yesterday' );
  38     isa_ok( $mtg, 'Mortgage' );
  39
  40     # check that coercion worked
  41     isa_ok( $mtg->closing_date, 'Fake::DateTime' );
  42 }
  43
  44 Mortgage->meta->make_immutable;
  45 ok( Mortgage->meta->is_immutable, '... Mortgage is now immutable' );
  46
  47 {
  48     my $mtg = Mortgage->new( closing_date => 'yesterday' );
  49     isa_ok( $mtg, 'Mortgage' );
  50
  51     # check that coercion worked
  52     isa_ok( $mtg->closing_date, 'Fake::DateTime' );
  53 }
  54
  55 done_testing;