1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140
|
use strict;
use warnings;
use Test::More;
use Test::Fatal;
use Class::MOP::Mixin::HasMethods;
# When the Perl debugger is enabled, %DB::sub tracks method information
# (line numbers and originating file). However, the reinitialize()
# functionality for classes and roles can sometimes clobber this information,
# causing to reference internal MOP files/lines instead.
# These tests check to make sure the reinitialize() functionality
# preserves the correct debugging information when it (re)adds methods
# back into a class or role.
BEGIN {
$^P = 831; # Enable debug mode
}
# Empty debugger
sub DB::DB {}
my ($foo_role_start, $foo_role_end, $foo_start_1, $foo_end_1, $foo_start_2, $foo_end_2);
# Simple Moose Role
{
package FooRole;
use Moose::Role;
$foo_role_start = __LINE__ + 1;
sub foo_role {
return 'FooRole::foo_role';
}
$foo_role_end = __LINE__ - 1;
}
# Simple Moose package
{
package Foo;
use Moose;
with 'FooRole';
# Track the start/end line numbers of method foo(), for comparison later
$foo_start_1 = __LINE__ + 1;
sub foo {
return 'foo';
}
$foo_end_1 = __LINE__ - 1;
no Moose;
}
# Extend our simple Moose package, with overriding method
{
package Bar;
use Moose;
extends 'Foo';
# Track the start/end line numbers of method foo(), for comparison later
$foo_start_2 = __LINE__ + 1;
sub foo {
return 'bar';
}
$foo_end_2 = __LINE__ - 1;
no Moose;
}
# Check that Foo and Bar classes were set up correctly
my $bar_object = Bar->new();
isa_ok(Foo->meta->get_method('foo'), 'Moose::Meta::Method');
isa_ok(Bar->meta->get_method('foo'), 'Moose::Meta::Method');
isa_ok(Foo->meta->get_method('foo_role'), 'Moose::Meta::Method');
is($bar_object->foo_role(), 'FooRole::foo_role', 'Bar object has access to foo_role method');
# Run tests against Bar meta class...
my $bar_meta = Bar->meta;
like($DB::sub{"Bar::foo"}, qr/add_method_debugmode\.t:($foo_start_2)-($foo_end_2)/, "Check line numbers for Bar::foo (initial)");
# Run _restore_metamethods_from directly (part of the reinitialize() process)
$bar_meta->_restore_metamethods_from($bar_meta);
like($DB::sub{"Foo::foo"}, qr/add_method_debugmode\.t:($foo_start_1)-($foo_end_1)/, "Check line numbers for Foo::foo (after _restore)");
like($DB::sub{"Bar::foo"}, qr/add_method_debugmode\.t:($foo_start_2)-($foo_end_2)/, "Check line numbers for Bar::foo (after _restore)");
# Call reinitialize explicitly, which triggers HasMethods::add_method
is( exception {
$bar_meta = $bar_meta->reinitialize('Bar');
}, undef );
isa_ok(Bar->meta->get_method('foo'), 'Moose::Meta::Method');
like($DB::sub{"Foo::foo"}, qr/add_method_debugmode\.t:($foo_start_1)-($foo_end_1)/, "Check line numbers for Foo::foo (after reinitialize)");
like($DB::sub{"Bar::foo"}, qr/add_method_debugmode\.t:($foo_start_2)-($foo_end_2)/, "Check line numbers for Bar::foo (after reinitialize)");
# Add a method to Bar; this triggers reinitialize as well
# Check that method line numbers are still listed as part of this file, and not a MOP file
$bar_meta->add_method('foo2' => sub { return 'new method foo2'; });
like($DB::sub{"Foo::foo"}, qr/add_method_debugmode\.t:($foo_start_1)-($foo_end_1)/, "Check line numbers for Foo::foo (after add_method)");
like($DB::sub{"Bar::foo"}, qr/add_method_debugmode\.t:($foo_start_2)-($foo_end_2)/, "Check line numbers for Bar::foo (after add_method)");
like($DB::sub{"Bar::foo2"}, qr/(.*):(\d+)-(\d+)/, "Check for existence of Bar::foo2");
# Clobber Bar::foo by adding a method with the same name
$bar_meta->add_method(
'foo' => $bar_meta->method_metaclass->wrap(
package_name => $bar_meta->name,
name => 'foo',
body => sub { return 'clobbered Bar::foo'; }
)
);
unlike($DB::sub{"Bar::foo"}, qr/add_method_debugmode\.t/, "Check that source file for Bar::foo has changed");
# Run tests against FooRole meta role ...
my $foorole_meta = FooRole->meta;
like($DB::sub{"FooRole::foo_role"}, qr/add_method_debugmode\.t:($foo_role_start)-($foo_role_end)/, "Check line numbers for FooRole::foo_role (initial)");
# Call _restore_metamethods_from directly
$foorole_meta->_restore_metamethods_from($foorole_meta);
like($DB::sub{"FooRole::foo_role"}, qr/add_method_debugmode\.t:($foo_role_start)-($foo_role_end)/, "Check line numbers for FooRole::foo_role (after _restore)");
# Call reinitialize
# Check that method line numbers are still listed as part of this file
is( exception {
$foorole_meta->reinitialize('FooRole');
}, undef );
isa_ok(FooRole->meta->get_method('foo_role'), 'Moose::Meta::Method');
like($DB::sub{"FooRole::foo_role"}, qr/add_method_debugmode\.t:($foo_role_start)-($foo_role_end)/, "Check line numbers for FooRole::foo_role (after reinitialize)");
# Clobber foo_role method
$foorole_meta->add_method(
'foo_role' => $foorole_meta->method_metaclass->wrap(
package_name => $foorole_meta->name,
name => 'foo_role',
body => sub { return 'clobbered FooRole::foo_role'; }
)
);
unlike($DB::sub{"FooRole::foo_role"}, qr/add_method_debugmode\.t/, "Check that source file for FooRole::foo_role has changed");
done_testing;
|