X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=t%2F020_attributes%2Ffailing%2F021_method_generation_rules.t;fp=t%2F020_attributes%2Ffailing%2F021_method_generation_rules.t;h=0000000000000000000000000000000000000000;hp=2169780ff58d683a26a169108f227b92ffec1b0e;hb=c47cf41554416ee1828eab17d31342a53aaa0839;hpb=9864f0e4ba233c5f30ad6dc7c484ced43d883d27 diff --git a/t/020_attributes/failing/021_method_generation_rules.t b/t/020_attributes/failing/021_method_generation_rules.t deleted file mode 100644 index 2169780..0000000 --- a/t/020_attributes/failing/021_method_generation_rules.t +++ /dev/null @@ -1,63 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; - -use Test::More tests => 17; -use Test::Exception; - - - -=pod - - is => rw, writer => _foo # turns into (reader => foo, writer => _foo) - is => ro, writer => _foo # turns into (reader => foo, writer => _foo) as before - is => rw, accessor => _foo # turns into (accessor => _foo) - is => ro, accessor => _foo # error, accesor is rw - -=cut - -sub make_class { - my ($is, $attr, $class) = @_; - - eval "package $class; use Mouse; has 'foo' => ( is => '$is', $attr => '_foo' );"; - - return $@ ? die $@ : $class; -} - -my $obj; -my $class; - -$class = make_class('rw', 'writer', 'Test::Class::WriterRW'); -ok($class, "Can define attr with rw + writer"); - -$obj = $class->new(); - -can_ok($obj, qw/foo _foo/); -lives_ok {$obj->_foo(1)} "$class->_foo is writer"; -is($obj->foo(), 1, "$class->foo is reader"); -dies_ok {$obj->foo(2)} "$class->foo is not writer"; # this should fail -ok(!defined $obj->_foo(), "$class->_foo is not reader"); - -$class = make_class('ro', 'writer', 'Test::Class::WriterRO'); -ok($class, "Can define attr with ro + writer"); - -$obj = $class->new(); - -can_ok($obj, qw/foo _foo/); -lives_ok {$obj->_foo(1)} "$class->_foo is writer"; -is($obj->foo(), 1, "$class->foo is reader"); -dies_ok {$obj->foo(1)} "$class->foo is not writer"; -isnt($obj->_foo(), 1, "$class->_foo is not reader"); - -$class = make_class('rw', 'accessor', 'Test::Class::AccessorRW'); -ok($class, "Can define attr with rw + accessor"); - -$obj = $class->new(); - -can_ok($obj, qw/_foo/); -lives_ok {$obj->_foo(1)} "$class->_foo is writer"; -is($obj->_foo(), 1, "$class->foo is reader"); - -dies_ok { make_class('ro', 'accessor', "Test::Class::AccessorRO"); } "Cant define attr with ro + accessor"; -