Testcase for get_code_info on a sub that's still being compiled

[gitmo/Class-MOP.git] / t / 082_get_code_info.t

use strict;
use warnings;

use Test::More;

BEGIN {
    $^P &= ~0x200; # Don't munger anonymous sub names
    if ( eval 'use Sub::Name qw(subname); 1;' ) {
        plan tests => 6;
    }
    else {
        plan skip_all => 'These tests require Sub::Name';
    }
}

BEGIN { use_ok("Class::MOP") }


sub code_name_is ($$$;$) {
    my ( $code, $stash, $name, $desc ) = @_;
    $desc ||= "sub name is ${stash}::$name";

    is_deeply(
        [ Class::MOP::get_code_info($code) ],
        [ $stash, $name ],
        $desc,
    );
}

code_name_is( sub {}, main => "__ANON__" );

code_name_is( subname("Foo::bar", sub {}), Foo => "bar" );

code_name_is( subname("", sub {}), "main" => "" );

require Class::MOP::Method;
code_name_is( \&Class::MOP::Method::name, "Class::MOP::Method", "name" );

{
    package Foo;

    sub MODIFY_CODE_ATTRIBUTES {
        my ($class, $code) = @_;
        ::ok(!Class::MOP::get_code_info($code), "no name for a coderef that's still compiling");
        return ();
    }

    sub foo : Bar {}
}