1use strict; 2use warnings; 3 4use Test::More; 5use Test::Fatal; 6 7use Class::MOP; 8use Class::MOP::Method; 9 10# test before and afters 11{ 12 my $trace = ''; 13 14 my $method = Class::MOP::Method->wrap( 15 body => sub { $trace .= 'primary' }, 16 package_name => 'main', 17 name => '__ANON__', 18 ); 19 isa_ok( $method, 'Class::MOP::Method' ); 20 21 $method->(); 22 is( $trace, 'primary', '... got the right return value from method' ); 23 $trace = ''; 24 25 my $wrapped = Class::MOP::Method::Wrapped->wrap($method); 26 isa_ok( $wrapped, 'Class::MOP::Method::Wrapped' ); 27 isa_ok( $wrapped, 'Class::MOP::Method' ); 28 29 $wrapped->(); 30 is( $trace, 'primary', 31 '... got the right return value from the wrapped method' ); 32 $trace = ''; 33 34 is( exception { 35 $wrapped->add_before_modifier( sub { $trace .= 'before -> ' } ); 36 }, undef, '... added the before modifier okay' ); 37 38 $wrapped->(); 39 is( $trace, 'before -> primary', 40 '... got the right return value from the wrapped method (w/ before)' 41 ); 42 $trace = ''; 43 44 is( exception { 45 $wrapped->add_after_modifier( sub { $trace .= ' -> after' } ); 46 }, undef, '... added the after modifier okay' ); 47 48 $wrapped->(); 49 is( $trace, 'before -> primary -> after', 50 '... got the right return value from the wrapped method (w/ before)' 51 ); 52 $trace = ''; 53} 54 55# test around method 56{ 57 my $method = Class::MOP::Method->wrap( 58 sub {4}, 59 package_name => 'main', 60 name => '__ANON__', 61 ); 62 isa_ok( $method, 'Class::MOP::Method' ); 63 64 is( $method->(), 4, '... got the right value from the wrapped method' ); 65 66 my $wrapped = Class::MOP::Method::Wrapped->wrap($method); 67 isa_ok( $wrapped, 'Class::MOP::Method::Wrapped' ); 68 isa_ok( $wrapped, 'Class::MOP::Method' ); 69 70 is( $wrapped->(), 4, '... got the right value from the wrapped method' ); 71 72 is( exception { 73 $wrapped->add_around_modifier( sub { ( 3, $_[0]->() ) } ); 74 $wrapped->add_around_modifier( sub { ( 2, $_[0]->() ) } ); 75 $wrapped->add_around_modifier( sub { ( 1, $_[0]->() ) } ); 76 $wrapped->add_around_modifier( sub { ( 0, $_[0]->() ) } ); 77 }, undef, '... added the around modifier okay' ); 78 79 is_deeply( 80 [ $wrapped->() ], 81 [ 0, 1, 2, 3, 4 ], 82 '... got the right results back from the around methods (in list context)' 83 ); 84 85 is( scalar $wrapped->(), 4, 86 '... got the right results back from the around methods (in scalar context)' 87 ); 88} 89 90{ 91 my @tracelog; 92 93 my $method = Class::MOP::Method->wrap( 94 sub { push @tracelog => 'primary' }, 95 package_name => 'main', 96 name => '__ANON__', 97 ); 98 isa_ok( $method, 'Class::MOP::Method' ); 99 100 my $wrapped = Class::MOP::Method::Wrapped->wrap($method); 101 isa_ok( $wrapped, 'Class::MOP::Method::Wrapped' ); 102 isa_ok( $wrapped, 'Class::MOP::Method' ); 103 104 is( exception { 105 $wrapped->add_before_modifier( sub { push @tracelog => 'before 1' } ); 106 $wrapped->add_before_modifier( sub { push @tracelog => 'before 2' } ); 107 $wrapped->add_before_modifier( sub { push @tracelog => 'before 3' } ); 108 }, undef, '... added the before modifier okay' ); 109 110 is( exception { 111 $wrapped->add_around_modifier( 112 sub { push @tracelog => 'around 1'; $_[0]->(); } ); 113 $wrapped->add_around_modifier( 114 sub { push @tracelog => 'around 2'; $_[0]->(); } ); 115 $wrapped->add_around_modifier( 116 sub { push @tracelog => 'around 3'; $_[0]->(); } ); 117 }, undef, '... added the around modifier okay' ); 118 119 is( exception { 120 $wrapped->add_after_modifier( sub { push @tracelog => 'after 1' } ); 121 $wrapped->add_after_modifier( sub { push @tracelog => 'after 2' } ); 122 $wrapped->add_after_modifier( sub { push @tracelog => 'after 3' } ); 123 }, undef, '... added the after modifier okay' ); 124 125 $wrapped->(); 126 is_deeply( 127 \@tracelog, 128 [ 129 'before 3', 'before 2', 'before 1', # last-in-first-out order 130 'around 3', 'around 2', 'around 1', # last-in-first-out order 131 'primary', 132 'after 1', 'after 2', 'after 3', # first-in-first-out order 133 ], 134 '... got the right tracelog from all our before/around/after methods' 135 ); 136} 137 138# test introspection 139{ 140 sub before1 { 141 } 142 143 sub before2 { 144 } 145 146 sub before3 { 147 } 148 149 sub after1 { 150 } 151 152 sub after2 { 153 } 154 155 sub after3 { 156 } 157 158 sub around1 { 159 } 160 161 sub around2 { 162 } 163 164 sub around3 { 165 } 166 167 sub orig { 168 } 169 170 my $method = Class::MOP::Method->wrap( 171 body => \&orig, 172 package_name => 'main', 173 name => '__ANON__', 174 ); 175 176 my $wrapped = Class::MOP::Method::Wrapped->wrap($method); 177 178 $wrapped->add_before_modifier($_) 179 for \&before1, \&before2, \&before3; 180 181 $wrapped->add_after_modifier($_) 182 for \&after1, \&after2, \&after3; 183 184 $wrapped->add_around_modifier($_) 185 for \&around1, \&around2, \&around3; 186 187 is( $wrapped->get_original_method, $method, 188 'check get_original_method' ); 189 190 is_deeply( [ $wrapped->before_modifiers ], 191 [ \&before3, \&before2, \&before1 ], 192 'check before_modifiers' ); 193 194 is_deeply( [ $wrapped->after_modifiers ], 195 [ \&after1, \&after2, \&after3 ], 196 'check after_modifiers' ); 197 198 is_deeply( [ $wrapped->around_modifiers ], 199 [ \&around3, \&around2, \&around1 ], 200 'check around_modifiers' ); 201} 202 203# test stringification of modifiers 204{ 205 package Parent; 206 use Moose; 207 208 sub something { 209 } 210} 211{ 212 package Child; 213 use Moose; 214 extends 'Parent'; 215 216 after 'something' => sub { 217 confess 'boom'; 218 }; 219} 220{ 221 my @errors; 222 local $SIG{__DIE__} = sub { push @errors, @_ }; 223 eval { Child->new->something() }; 224 my $msg = join "\n", @errors; 225 ::like($msg, qr/^boom at /, 'correct exception'); 226 ::like($msg, qr/:::after/, 'stacktrace contains :after'); 227 ::like($msg, qr/Child::_wrapped_something/, 'stacktrace contains wrapped method name'); 228 ::unlike($msg, qr/__ANON__/, 'stacktrace does not contain __ANON__'); 229 ::note($msg); 230} 231 232done_testing; 233