t-failing/010_basics/012_rebless.t

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