Add tests to make sure the new reblessing works with Moosey bits
Shawn M Moore [Sun, 13 Jan 2008 00:06:54 +0000 (00:06 +0000)]
t/010_basics/012_rebless.t [new file with mode: 0644]

diff --git a/t/010_basics/012_rebless.t b/t/010_basics/012_rebless.t
new file mode 100644 (file)
index 0000000..8b61297
--- /dev/null
@@ -0,0 +1,82 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 13;
+use Test::Exception;
+use Scalar::Util 'blessed';
+
+BEGIN {
+    use_ok('Moose');
+    use_ok("Moose::Util::TypeConstraints");
+}
+
+subtype 'Positive'
+     => as 'Num'
+     => where { $_ > 0 };
+
+{
+    package Parent;
+    use Moose;
+
+    has name => (
+        is       => 'rw',
+        isa      => 'Str',
+    );
+
+    has lazy_classname => (
+        is      => 'ro',
+        lazy    => 1,
+        default => sub { "Parent" },
+    );
+
+    has type_constrained => (
+        is      => 'rw',
+        isa     => 'Num',
+        default => 5.5,
+    );
+
+    package Child;
+    use Moose;
+    extends 'Parent';
+
+    has '+name' => (
+        default => 'Junior',
+    );
+
+    has '+lazy_classname' => (
+        default => sub { "Child" },
+    );
+
+    has '+type_constrained' => (
+        isa     => 'Int',
+        default => 100,
+    );
+}
+
+my $foo = Parent->new;
+my $bar = Parent->new;
+
+is(blessed($foo), 'Parent', 'Parent->new gives a Parent object');
+is($foo->name, undef, 'No name yet');
+is($foo->lazy_classname, 'Parent', "lazy attribute initialized");
+lives_ok { $foo->type_constrained(10.5) } "Num type constraint for now..";
+
+# try to rebless, except it will fail due to Child's stricter type constraint
+throws_ok { $foo->meta->rebless_instance($foo => 'Child') } qr/^Attribute \(type_constrained\) does not pass the type constraint \(Int\) with '10\.5'/;
+throws_ok { $bar->meta->rebless_instance($bar => 'Child') } qr/^Attribute \(type_constrained\) does not pass the type constraint \(Int\) with '5\.5'/;
+
+$foo->type_constrained(10);
+$bar->type_constrained(5);
+
+$foo->meta->rebless_instance($foo => 'Child');
+$bar->meta->rebless_instance($bar => 'Child');
+
+is(blessed($foo), 'Child', 'successfully reblessed into Child');
+is($foo->name, 'Junior', "Child->name's default came through");
+
+is($foo->lazy_classname, 'Parent', "lazy attribute was already initialized");
+is($bar->lazy_classname, 'Child', "lazy attribute just now initialized");
+
+throws_ok { $foo->type_constrained(10.5) } qr/^Attribute \(type_constrained\) does not pass the type constraint \(Int\) with 10\.5 /;