t/082_get_code_info.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More tests => 6;
   5 use Sub::Name 'subname';
   6
   7 BEGIN {
   8     $^P &= ~0x200; # Don't munger anonymous sub names
   9 }
  10
  11 BEGIN { use_ok("Class::MOP") }
  12
  13
  14 sub code_name_is ($$$;$) {
  15     my ( $code, $stash, $name, $desc ) = @_;
  16     $desc ||= "sub name is ${stash}::$name";
  17
  18     is_deeply(
  19         [ Class::MOP::get_code_info($code) ],
  20         [ $stash, $name ],
  21         $desc,
  22     );
  23 }
  24
  25 code_name_is( sub {}, main => "__ANON__" );
  26
  27 code_name_is( subname("Foo::bar", sub {}), Foo => "bar" );
  28
  29 code_name_is( subname("", sub {}), "main" => "" );
  30
  31 require Class::MOP::Method;
  32 code_name_is( \&Class::MOP::Method::name, "Class::MOP::Method", "name" );
  33
  34 {
  35     package Foo;
  36
  37     sub MODIFY_CODE_ATTRIBUTES {
  38         my ($class, $code) = @_;
  39         ::ok(!Class::MOP::get_code_info($code), "no name for a coderef that's still compiling");
  40         return ();
  41     }
  42
  43     sub foo : Bar {}
  44 }