t/030_method.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 39;
   7 use Test::Exception;
   8
   9 use Class::MOP;
  10 use Class::MOP::Method;
  11
  12
  13 my $method = Class::MOP::Method->wrap(
  14     sub { 1 },
  15     package_name => 'main',
  16     name         => '__ANON__',
  17 );
  18 is($method->meta, Class::MOP::Method->meta, '... instance and class both lead to the same meta');
  19
  20 is($method->package_name, 'main', '... our package is main::');
  21 is($method->name, '__ANON__', '... our sub name is __ANON__');
  22 is($method->fully_qualified_name, 'main::__ANON__', '... our subs full name is main::__ANON__');
  23 is($method->original_method, undef, '... no original_method ');
  24 is($method->original_package_name, 'main', '... the original_package_name is the same as package_name');
  25 is($method->original_name, '__ANON__', '... the original_name is the same as name');
  26 is($method->original_fully_qualified_name, 'main::__ANON__', '... the original_fully_qualified_name is the same as fully_qualified_name');
  27
  28 dies_ok { Class::MOP::Method->wrap } q{... can't call wrap() without some code};
  29 dies_ok { Class::MOP::Method->wrap([]) } q{... can't call wrap() without some code};
  30 dies_ok { Class::MOP::Method->wrap(bless {} => 'Fail') } q{... can't call wrap() without some code};
  31
  32 dies_ok { Class::MOP::Method->name } q{... can't call name() as a class method};
  33 dies_ok { Class::MOP::Method->body } q{... can't call body() as a class method};
  34 dies_ok { Class::MOP::Method->package_name } q{... can't call package_name() as a class method};
  35 dies_ok { Class::MOP::Method->fully_qualified_name } q{... can't call fully_qualified_name() as a class method};
  36
  37 my $meta = Class::MOP::Method->meta;
  38 isa_ok($meta, 'Class::MOP::Class');
  39
  40 foreach my $method_name (qw(
  41     wrap
  42         package_name
  43         name
  44     )) {
  45     ok($meta->has_method($method_name), '... Class::MOP::Method->has_method(' . $method_name . ')');
  46         my $method = $meta->get_method($method_name);
  47         is($method->package_name, 'Class::MOP::Method', '... our package is Class::MOP::Method');
  48         is($method->name, $method_name, '... our sub name is "' . $method_name . '"');
  49 }
  50
  51 dies_ok {
  52     Class::MOP::Method->wrap()
  53 } '... bad args for &wrap';
  54
  55 dies_ok {
  56     Class::MOP::Method->wrap('Fail')
  57 } '... bad args for &wrap';
  58
  59 dies_ok {
  60     Class::MOP::Method->wrap([])
  61 } '... bad args for &wrap';
  62
  63 dies_ok {
  64     Class::MOP::Method->wrap(sub { 'FAIL' })
  65 } '... bad args for &wrap';
  66
  67 dies_ok {
  68     Class::MOP::Method->wrap(sub { 'FAIL' }, package_name => 'main')
  69 } '... bad args for &wrap';
  70
  71 dies_ok {
  72     Class::MOP::Method->wrap(sub { 'FAIL' }, name => '__ANON__')
  73 } '... bad args for &wrap';
  74
  75 my $clone = $method->clone(
  76     package_name => 'NewPackage',
  77     name         => 'new_name',
  78 );
  79
  80 isa_ok($clone, 'Class::MOP::Method');
  81 is($clone->package_name, 'NewPackage', '... cloned method has new pckage name');
  82 is($clone->name, 'new_name', '... cloned method has new sub name');
  83 is($clone->fully_qualified_name, 'NewPackage::new_name', '... cloned method has new fq name');
  84 is($clone->original_method, $method, '... cloned method has correct original_method');
  85 is($clone->original_package_name, 'main', '... cloned method has correct original_package_name');
  86 is($clone->original_name, '__ANON__', '... cloned method has correct original_name');
  87 is($clone->original_fully_qualified_name, 'main::__ANON__', '... cloned method has correct original_fully_qualified_name');