t/basics/rebless.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Fatal;
   8 use Test::Moose qw(with_immutable);
   9 use Scalar::Util 'blessed';
  10
  11 use Moose::Util::TypeConstraints;
  12
  13 subtype 'Positive'
  14      => as 'Num'
  15      => where { $_ > 0 };
  16
  17 {
  18     package Parent;
  19     use Moose;
  20
  21     has name => (
  22         is       => 'rw',
  23         isa      => 'Str',
  24     );
  25
  26     has lazy_classname => (
  27         is      => 'ro',
  28         lazy    => 1,
  29         default => sub { "Parent" },
  30     );
  31
  32     has type_constrained => (
  33         is      => 'rw',
  34         isa     => 'Num',
  35         default => 5.5,
  36     );
  37
  38     package Child;
  39     use Moose;
  40     extends 'Parent';
  41
  42     has '+name' => (
  43         default => 'Junior',
  44     );
  45
  46     has '+lazy_classname' => (
  47         default => sub {"Child"},
  48     );
  49
  50     has '+type_constrained' => (
  51         isa     => 'Int',
  52         default => 100,
  53     );
  54
  55     our %trigger_calls;
  56     our %initializer_calls;
  57
  58     has new_attr => (
  59         is      => 'rw',
  60         isa     => 'Str',
  61         trigger => sub {
  62             my ( $self, $val, $attr ) = @_;
  63             $trigger_calls{new_attr}++;
  64         },
  65         initializer => sub {
  66             my ( $self, $value, $set, $attr ) = @_;
  67             $initializer_calls{new_attr}++;
  68             $set->($value);
  69         },
  70     );
  71 }
  72
  73 my @classes = qw(Parent Child);
  74
  75 with_immutable {
  76     my $foo = Parent->new;
  77     my $bar = Parent->new;
  78
  79     is( blessed($foo),        'Parent', 'Parent->new gives a Parent object' );
  80     is( $foo->name,           undef,    'No name yet' );
  81     is( $foo->lazy_classname, 'Parent', "lazy attribute initialized" );
  82     is(
  83         exception { $foo->type_constrained(10.5) }, undef,
  84         "Num type constraint for now.."
  85     );
  86
  87     # try to rebless, except it will fail due to Child's stricter type constraint
  88     like(
  89         exception { Child->meta->rebless_instance($foo) },
  90         qr/^Attribute \(type_constrained\) does not pass the type constraint because\: Validation failed for 'Int' with value 10\.5/,
  91         '... this failed because of type check'
  92     );
  93     like(
  94         exception { Child->meta->rebless_instance($bar) },
  95         qr/^Attribute \(type_constrained\) does not pass the type constraint because\: Validation failed for 'Int' with value 5\.5/,
  96         '... this failed because of type check'
  97     );
  98
  99     $foo->type_constrained(10);
 100     $bar->type_constrained(5);
 101
 102     Child->meta->rebless_instance($foo);
 103     Child->meta->rebless_instance( $bar, new_attr => 'blah' );
 104
 105     is( blessed($foo), 'Child',  'successfully reblessed into Child' );
 106     is( $foo->name,    'Junior', "Child->name's default came through" );
 107
 108     is(
 109         $foo->lazy_classname, 'Parent',
 110         "lazy attribute was already initialized"
 111     );
 112     is(
 113         $bar->lazy_classname, 'Child',
 114         "lazy attribute just now initialized"
 115     );
 116
 117     like(
 118         exception { $foo->type_constrained(10.5) },
 119         qr/^Attribute \(type_constrained\) does not pass the type constraint because\: Validation failed for 'Int' with value 10\.5/,
 120         '... this failed because of type check'
 121     );
 122
 123     is_deeply(
 124         \%Child::trigger_calls, { new_attr => 1 },
 125         'Trigger fired on rebless_instance'
 126     );
 127     is_deeply(
 128         \%Child::initializer_calls, { new_attr => 1 },
 129         'Initializer fired on rebless_instance'
 130     );
 131
 132     undef %Child::trigger_calls;
 133     undef %Child::initializer_calls;
 134
 135 }
 136 @classes;
 137
 138 done_testing;