Add tests for get_value etc
gfx [Wed, 16 Dec 2009 08:51:49 +0000 (17:51 +0900)]
t/001_mouse/065-attr-mop.t [new file with mode: 0644]

diff --git a/t/001_mouse/065-attr-mop.t b/t/001_mouse/065-attr-mop.t
new file mode 100644 (file)
index 0000000..909d317
--- /dev/null
@@ -0,0 +1,32 @@
+#!perl
+use strict;
+use warnings;
+use Test::More tests => 10;
+use Test::Mouse;
+
+{
+    package MyClass;
+    use Mouse;
+
+    has 'foo' => (
+        is => 'bare',
+    );
+}
+
+with_immutable {
+    my $obj = MyClass->new();
+    my $foo = $obj->meta->get_attribute('foo');
+    ok $foo, $obj->meta->is_immutable ? 'immutable' : 'mutable';
+
+    ok !$foo->has_value($obj), 'has_value';
+
+    $foo->set_value($obj, 'bar');
+    is $foo->get_value($obj), 'bar', 'set_value/get_value';
+
+    ok $foo->has_value($obj), 'has_value';
+
+    $foo->clear_value($obj);
+
+    ok!$foo->has_value($obj), 'clear_value';
+
+} qw(MyClass);