Commit | Line | Data |
38bf2a25 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Class::MOP; |
5 | use Class::MOP::Class; |
6 | use Test::More; |
7 | use Test::Fatal; |
8 | |
9 | my %results; |
10 | |
11 | { |
12 | |
13 | package Base; |
14 | use metaclass; |
15 | sub hey { $results{base}++ } |
16 | } |
17 | |
18 | for my $wrap (qw(before after)) { |
19 | my $meta = Class::MOP::Class->create_anon_class( |
20 | superclasses => [ 'Base', 'Class::MOP::Object' ] ); |
21 | my $alter = "add_${wrap}_method_modifier"; |
22 | $meta->$alter( |
23 | 'hey' => sub { |
24 | $results{wrapped}++; |
25 | $_ = 'barf'; # 'barf' would replace the cached wrapper subref |
26 | } |
27 | ); |
28 | |
29 | %results = (); |
30 | my $o = $meta->get_meta_instance->create_instance; |
31 | isa_ok( $o, 'Base' ); |
32 | is( exception { |
33 | $o->hey; |
34 | $o->hey |
35 | ; # this would die with 'Can't use string ("barf") as a subroutine ref while "strict refs" in use' |
36 | }, undef, 'wrapped doesn\'t die when $_ gets changed' ); |
37 | is_deeply( |
38 | \%results, { base => 2, wrapped => 2 }, |
39 | 'saw expected calls to wrappers' |
40 | ); |
41 | } |
42 | |
43 | { |
44 | my $meta = Class::MOP::Class->create_anon_class( |
45 | superclasses => [ 'Base', 'Class::MOP::Object' ] ); |
46 | for my $wrap (qw(before after)) { |
47 | my $alter = "add_${wrap}_method_modifier"; |
48 | $meta->$alter( |
49 | 'hey' => sub { |
50 | $results{wrapped}++; |
51 | $_ = 'barf'; # 'barf' would replace the cached wrapper subref |
52 | } |
53 | ); |
54 | } |
55 | |
56 | %results = (); |
57 | my $o = $meta->get_meta_instance->create_instance; |
58 | isa_ok( $o, 'Base' ); |
59 | is( exception { |
60 | $o->hey; |
61 | $o->hey |
62 | ; # this would die with 'Can't use string ("barf") as a subroutine ref while "strict refs" in use' |
63 | }, undef, 'double-wrapped doesn\'t die when $_ gets changed' ); |
64 | is_deeply( |
65 | \%results, { base => 2, wrapped => 4 }, |
66 | 'saw expected calls to wrappers' |
67 | ); |
68 | } |
69 | |
70 | done_testing; |