t/010_basics/012_rebless.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 13;
   7 use Test::Exception;
   8 use Scalar::Util 'blessed';
   9
  10 BEGIN {
  11     use_ok('Moose');
  12     use_ok("Moose::Util::TypeConstraints");
  13 }
  14
  15 subtype 'Positive'
  16      => as 'Num'
  17      => where { $_ > 0 };
  18
  19 {
  20     package Parent;
  21     use Moose;
  22
  23     has name => (
  24         is       => 'rw',
  25         isa      => 'Str',
  26     );
  27
  28     has lazy_classname => (
  29         is      => 'ro',
  30         lazy    => 1,
  31         default => sub { "Parent" },
  32     );
  33
  34     has type_constrained => (
  35         is      => 'rw',
  36         isa     => 'Num',
  37         default => 5.5,
  38     );
  39
  40     package Child;
  41     use Moose;
  42     extends 'Parent';
  43
  44     has '+name' => (
  45         default => 'Junior',
  46     );
  47
  48     has '+lazy_classname' => (
  49         default => sub { "Child" },
  50     );
  51
  52     has '+type_constrained' => (
  53         isa     => 'Int',
  54         default => 100,
  55     );
  56 }
  57
  58 my $foo = Parent->new;
  59 my $bar = Parent->new;
  60
  61 is(blessed($foo), 'Parent', 'Parent->new gives a Parent object');
  62 is($foo->name, undef, 'No name yet');
  63 is($foo->lazy_classname, 'Parent', "lazy attribute initialized");
  64 lives_ok { $foo->type_constrained(10.5) } "Num type constraint for now..";
  65
  66 # try to rebless, except it will fail due to Child's stricter type constraint
  67 throws_ok { Child->meta->rebless_instance($foo) } qr/^Attribute \(type_constrained\) does not pass the type constraint \(Int\) with '10\.5'/;
  68 throws_ok { Child->meta->rebless_instance($bar) } qr/^Attribute \(type_constrained\) does not pass the type constraint \(Int\) with '5\.5'/;
  69
  70 $foo->type_constrained(10);
  71 $bar->type_constrained(5);
  72
  73 Child->meta->rebless_instance($foo);
  74 Child->meta->rebless_instance($bar);
  75
  76 is(blessed($foo), 'Child', 'successfully reblessed into Child');
  77 is($foo->name, 'Junior', "Child->name's default came through");
  78
  79 is($foo->lazy_classname, 'Parent', "lazy attribute was already initialized");
  80 is($bar->lazy_classname, 'Child', "lazy attribute just now initialized");
  81
  82 throws_ok { $foo->type_constrained(10.5) } qr/^Attribute \(type_constrained\) does not pass the type constraint \(Int\) with 10\.5 /;