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
|
use strict;
use warnings;
use Class::MOP;
use Class::MOP::Class;
use Test::More;
use Test::Fatal;
my %results;
{
package Base::Class;
use metaclass;
sub hey { $results{base}++ }
}
for my $wrap (qw(before after)) {
my $meta = Class::MOP::Class->create_anon_class(
superclasses => [ 'Base::Class', 'Class::MOP::Object' ] );
my $alter = "add_${wrap}_method_modifier";
$meta->$alter(
'hey' => sub {
$results{wrapped}++;
$_ = 'barf'; # 'barf' would replace the cached wrapper subref
}
);
%results = ();
my $o = $meta->get_meta_instance->create_instance;
isa_ok( $o, 'Base::Class' );
is( exception {
$o->hey;
$o->hey
; # this would die with 'Can't use string ("barf") as a subroutine ref while "strict refs" in use'
}, undef, 'wrapped doesn\'t die when $_ gets changed' );
is_deeply(
\%results, { base => 2, wrapped => 2 },
'saw expected calls to wrappers'
);
}
{
my $meta = Class::MOP::Class->create_anon_class(
superclasses => [ 'Base::Class', 'Class::MOP::Object' ] );
for my $wrap (qw(before after)) {
my $alter = "add_${wrap}_method_modifier";
$meta->$alter(
'hey' => sub {
$results{wrapped}++;
$_ = 'barf'; # 'barf' would replace the cached wrapper subref
}
);
}
%results = ();
my $o = $meta->get_meta_instance->create_instance;
isa_ok( $o, 'Base::Class' );
is( exception {
$o->hey;
$o->hey
; # this would die with 'Can't use string ("barf") as a subroutine ref while "strict refs" in use'
}, undef, 'double-wrapped doesn\'t die when $_ gets changed' );
is_deeply(
\%results, { base => 2, wrapped => 4 },
'saw expected calls to wrappers'
);
}
done_testing;
|
