From: Shawn M Moore <sartak@gmail.com>
Date: Mon, 3 Mar 2008 05:32:41 +0000 (+0000)
Subject: Failing make_immutable test case. It seems that inherited "new" is just plain broken... 
X-Git-Tag: 0_55~290
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0aac92c5d5e38aceb9027a9aff430cd6b875ae01;p=gitmo%2FMoose.git

Failing make_immutable test case. It seems that inherited "new" is just plain broken. And I was bitten by this one, so it's not academic :)
---

diff --git a/t/300_immutable/006_immutable_nonmoose_subclass.t b/t/300_immutable/006_immutable_nonmoose_subclass.t
new file mode 100644
index 0000000..5445a9e
--- /dev/null
+++ b/t/300_immutable/006_immutable_nonmoose_subclass.t
@@ -0,0 +1,69 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 10;
+use Test::Exception;
+use Scalar::Util 'blessed';
+
+BEGIN {
+    use_ok('Moose');
+    use_ok('Moose::Meta::Role');
+}
+
+{
+    package Grandparent;
+
+    sub new {
+        my $class = shift;
+        my %args  = (
+            grandparent => 'gramma',
+            @_,
+        );
+
+        bless \%args => $class;
+    }
+
+    sub grandparent { 1 }
+}
+
+{
+    package Parent;
+    use Moose;
+    extends 'Grandparent';
+
+    around new => sub {
+        my $orig  = shift;
+        my $class = shift;
+
+        $class->$orig(
+            parent => 'mama',
+            @_,
+        );
+    };
+
+    sub parent { 1 }
+}
+
+{
+    package Child;
+    use Moose;
+    extends 'Parent';
+
+    sub child { 1 }
+
+    make_immutable;
+}
+
+is(blessed(Grandparent->new), "Grandparent", "got a Grandparent object out of Grandparent->new");
+is(blessed(Parent->new), "Parent", "got a Parent object out of Parent->new");
+is(blessed(Child->new), "Child", "got a Child object out of Child->new");
+
+is(Child->new->grandparent, 1, "Child responds to grandparent");
+is(Child->new->parent, 1, "Child responds to parent");
+is(Child->new->child, 1, "Child responds to child");
+
+is(Child->new->{grandparent}, 'gramma', "Instance structure has attributes");
+is(Child->new->{parent}, 'mama', "Parent's 'around' is respected");
+