X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F020_attributes%2Ffailing%2F021_method_generation_rules.t;fp=t%2F020_attributes%2Ffailing%2F021_method_generation_rules.t;h=2169780ff58d683a26a169108f227b92ffec1b0e;hb=4060c871da12ba3c5e88986ed121a8254f906bd6;hp=0000000000000000000000000000000000000000;hpb=95ecd6f132112c6763cdaf2e6bc72c39e9ab76b5;p=gitmo%2FMouse.git

diff --git a/t/020_attributes/failing/021_method_generation_rules.t b/t/020_attributes/failing/021_method_generation_rules.t
new file mode 100644
index 0000000..2169780
--- /dev/null
+++ b/t/020_attributes/failing/021_method_generation_rules.t
@@ -0,0 +1,63 @@
+#!/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";
+