t/309_subname.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5
   6 use Class::MOP;
   7
   8 {
   9
  10     package Origin;
  11     sub bar { ( caller(0) )[3] }
  12
  13     package Foo;
  14 }
  15
  16 my $Foo = Class::MOP::Class->initialize('Foo');
  17
  18 $Foo->add_method( foo => sub { ( caller(0) )[3] } );
  19
  20 is_deeply(
  21     [ Class::MOP::get_code_info( $Foo->get_method('foo')->body ) ],
  22     [ "Foo", "foo" ],
  23     "subname applied to anonymous method",
  24 );
  25
  26 is( Foo->foo, "Foo::foo", "caller() aggrees" );
  27
  28 $Foo->add_method( bar => \&Origin::bar );
  29
  30 is( Origin->bar, "Origin::bar", "normal caller() operation in unrelated class" );
  31
  32 is_deeply(
  33     [ Class::MOP::get_code_info( $Foo->get_method('foo')->body ) ],
  34     [ "Foo", "foo" ],
  35     "subname not applied if a name already exists",
  36 );
  37
  38 is( Foo->bar, "Origin::bar", "caller aggrees" );
  39
  40 is( Origin->bar, "Origin::bar", "unrelated class untouched" );
  41
  42 done_testing;