X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F050_metaclasses%2Ffailing%2F004_moose_for_meta.t;fp=t%2F050_metaclasses%2Ffailing%2F004_moose_for_meta.t;h=0000000000000000000000000000000000000000;hb=fde8e43f95fe996fbc2a778aa259feeb04552171;hp=21d3a9ac2832e354a0d9f531b991a27a5a0c1d90;hpb=0bdc9d38dfd3de07aad929f6629f8fa65d434c27;p=gitmo%2FMouse.git diff --git a/t/050_metaclasses/failing/004_moose_for_meta.t b/t/050_metaclasses/failing/004_moose_for_meta.t deleted file mode 100644 index 21d3a9a..0000000 --- a/t/050_metaclasses/failing/004_moose_for_meta.t +++ /dev/null @@ -1,79 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; - -use Test::More tests => 16; -use Test::Exception; - - - -=pod - -This test demonstrates the ability to extend -Mouse meta-level classes using Mouse itself. - -=cut - -{ - package My::Meta::Class; - use Mouse; - - extends 'Mouse::Meta::Class'; - - around 'create_anon_class' => sub { - my $next = shift; - my ($self, %options) = @_; - $options{superclasses} = [ 'Mouse::Object' ] - unless exists $options{superclasses}; - $next->($self, %options); - }; -} - -my $anon = My::Meta::Class->create_anon_class(); -isa_ok($anon, 'My::Meta::Class'); -isa_ok($anon, 'Mouse::Meta::Class'); -isa_ok($anon, 'Class::MOP::Class'); - -is_deeply( - [ $anon->superclasses ], - [ 'Mouse::Object' ], - '... got the default superclasses'); - -{ - package My::Meta::Attribute::DefaultReadOnly; - use Mouse; - - extends 'Mouse::Meta::Attribute'; - - around 'new' => sub { - my $next = shift; - my ($self, $name, %options) = @_; - $options{is} = 'ro' - unless exists $options{is}; - $next->($self, $name, %options); - }; -} - -{ - my $attr = My::Meta::Attribute::DefaultReadOnly->new('foo'); - isa_ok($attr, 'My::Meta::Attribute::DefaultReadOnly'); - isa_ok($attr, 'Mouse::Meta::Attribute'); - isa_ok($attr, 'Class::MOP::Attribute'); - - ok($attr->has_reader, '... the attribute has a reader (as expected)'); - ok(!$attr->has_writer, '... the attribute does not have a writer (as expected)'); - ok(!$attr->has_accessor, '... the attribute does not have an accessor (as expected)'); -} - -{ - my $attr = My::Meta::Attribute::DefaultReadOnly->new('foo', (is => 'rw')); - isa_ok($attr, 'My::Meta::Attribute::DefaultReadOnly'); - isa_ok($attr, 'Mouse::Meta::Attribute'); - isa_ok($attr, 'Class::MOP::Attribute'); - - ok(!$attr->has_reader, '... the attribute does not have a reader (as expected)'); - ok(!$attr->has_writer, '... the attribute does not have a writer (as expected)'); - ok($attr->has_accessor, '... the attribute does have an accessor (as expected)'); -} -