The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

ETHER / Moose-2.2207 / t / cmop / add_method_debugmode.t 

            

              
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;