Ensure that generated accessors are XS
gfx [Wed, 19 Aug 2009 07:47:18 +0000 (16:47 +0900)]
t/088_xs_accessor.t [new file with mode: 0755]

diff --git a/t/088_xs_accessor.t b/t/088_xs_accessor.t
new file mode 100755 (executable)
index 0000000..e70348e
--- /dev/null
@@ -0,0 +1,32 @@
+use strict;
+use warnings;
+use Test::More tests => 5;
+use Class::MOP;
+
+use B qw(svref_2object);
+
+sub method_type{
+    my($class, $method) = @_;
+    return svref_2object($class->can($method))->XSUB    ? 'XS'
+         : $class->meta->get_method($method)->is_inline ? 'Inline'
+                                                        : 'Basic';
+}
+
+
+{
+    package Foo;
+    use metaclass;
+    __PACKAGE__->meta->add_attribute('r'  => (reader    => 'r'));
+    __PACKAGE__->meta->add_attribute('w'  => (writer    => 'w'));
+    __PACKAGE__->meta->add_attribute('a'  => (accessor  => 'a'));
+    __PACKAGE__->meta->add_attribute('c'  => (clearer   => 'c'));
+    __PACKAGE__->meta->add_attribute('p'  => (predicate => 'p'));
+}
+
+is method_type('Foo', 'r'), 'XS', 'reader is XS';
+is method_type('Foo', 'w'), 'XS', 'writer is XS';
+is method_type('Foo', 'a'), 'XS', 'accessor is XS';
+is method_type('Foo', 'c'), 'XS', 'clearer is XS';
+is method_type('Foo', 'p'), 'XS', 'predicate is XS';
+
+