Add a test file to extend metaclasses
gfx [Fri, 2 Oct 2009 10:54:00 +0000 (19:54 +0900)]
lib/Mouse/Meta/Class.pm
t/053-extends-meta.t [new file with mode: 0755]

index 99944e8..4f811d9 100644 (file)
@@ -25,10 +25,11 @@ sub _construct_meta {
         \@{ $args{package} . '::ISA' };
     };
 
-    #return Mouse::Meta::Class->initialize($class)->new_object(%args)
-    #    if $class ne __PACKAGE__;
-
-    return bless \%args, ref($class) || $class;
+    my $self = bless \%args, ref($class) || $class;
+    if($class ne __PACKAGE__){
+        $self->_initialize_object($self, \%args);
+    }
+    return $self;
 }
 
 sub create_anon_class{
diff --git a/t/053-extends-meta.t b/t/053-extends-meta.t
new file mode 100755 (executable)
index 0000000..76c9753
--- /dev/null
@@ -0,0 +1,56 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 12;
+use Test::Exception;
+{
+    package My::Meta::Class;
+    use Mouse;
+    extends 'Mouse::Meta::Class';
+
+    has my_class_attr => (
+        is      => 'rw',
+        default => 42,
+    );
+    package My::Meta::Role;
+    use Mouse;
+    extends 'Mouse::Meta::Role';
+
+    has my_role_attr => (
+        is      => 'rw',
+        default => 43,
+    );
+    package My::Meta::Attribute;
+    use Mouse;
+    extends 'Mouse::Meta::Attribute';
+
+    has my_attr_attr => (
+        is      => 'rw',
+        default => 44,
+    );
+}
+
+my $meta = My::Meta::Class->initialize('Foo');
+isa_ok $meta, 'My::Meta::Class';
+can_ok $meta, qw(name my_class_attr);
+is $meta->name, 'Foo';
+lives_and{
+    is $meta->my_class_attr, 42;
+};
+
+$meta = My::Meta::Role->initialize('Bar');
+isa_ok $meta, 'My::Meta::Role';
+can_ok $meta, qw(name my_role_attr);
+is $meta->name, 'Bar';
+lives_and{
+    is $meta->my_role_attr, 43;
+};
+
+$meta = My::Meta::Attribute->new('baz');
+isa_ok $meta, 'My::Meta::Attribute';
+can_ok $meta, qw(name my_attr_attr);
+is $meta->name, 'baz';
+lives_and{
+    is $meta->my_attr_attr, 44;
+};
+