t/088_xs_accessor.t

   1 use strict;
   2 use warnings;
   3 use Test::More tests => 5;
   4 use Class::MOP;
   5
   6 use B qw(svref_2object);
   7
   8 sub method_type{
   9     my($class, $method) = @_;
  10     return svref_2object($class->can($method))->XSUB    ? 'XS'
  11          : $class->meta->get_method($method)->is_inline ? 'Inline'
  12                                                         : 'Basic';
  13 }
  14
  15
  16 {
  17     package Foo;
  18     use metaclass;
  19     __PACKAGE__->meta->add_attribute('r'  => (reader    => 'r'));
  20     __PACKAGE__->meta->add_attribute('w'  => (writer    => 'w'));
  21     __PACKAGE__->meta->add_attribute('a'  => (accessor  => 'a'));
  22     __PACKAGE__->meta->add_attribute('c'  => (clearer   => 'c'));
  23     __PACKAGE__->meta->add_attribute('p'  => (predicate => 'p'));
  24 }
  25
  26 is method_type('Foo', 'r'), 'XS', 'reader is XS';
  27 is method_type('Foo', 'w'), 'XS', 'writer is XS';
  28 is method_type('Foo', 'a'), 'XS', 'accessor is XS';
  29 is method_type('Foo', 'c'), 'XS', 'clearer is XS';
  30 is method_type('Foo', 'p'), 'XS', 'predicate is XS';
  31
  32