t/010_basics/failing/012_rebless.t

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