#!/usr/bin/perl # Miscellaneous additional tests for around use strict; BEGIN { $| = 1; $^W = 1; } use Test::More tests => 28; use Test::NoWarnings; use Aspect; my $around = 0; my $foo = 0; my $bar = 0; my $baz = 0; CLASS: { package Foo; sub new { bless {}, $_[0] } sub foo { $foo++; return 'foo'; } sub bar { $bar++; return 'bar'; } sub baz { $baz++; return 'baz'; } 1; } # Check that a simple null case (not passing through) # does not run the function SCOPE: { my $aspect = around { $around++ } call 'Foo::foo'; isa_ok( $aspect, 'Aspect::Advice::Around' ); my $object = Foo->new; isa_ok( $object, 'Foo' ); # Check return values in all three contexts my @rv = $object->foo; my $rv = $object->foo; $object->foo; is_deeply( \@rv, [ ], 'Listwise null around returns null list' ); is( $rv, undef, 'Scalar null around returns undef' ); is( $around, 3, 'Three calls were made to the advice' ); is( $foo, 0, 'No calls were made to the underlying method' ); } # Check that the aspect hooks are correctly removed SCOPE: { my $rv = Foo->new->foo; is( $rv, 'foo', 'Method now returns correctly' ); is( $around, 3, 'No additional calls made to the advice' ); is( $foo, 1, 'Calls were correctly restored to the underlying method' ); } # Check we can run the original method ourself. # Check that around aspects in void context last forever. SCOPE: { around { $around += 2; my $rv = $_[0]->original->(); $_[0]->return_value($rv); } call 'Foo::bar'; my $object = Foo->new; isa_ok( $object, 'Foo' ); my $rv = $object->bar; is( $rv, 'bar', 'Got return value from the underlying call' ); is( $bar, 1, 'Underlying method was called once' ); is( $around, 5, 'Advice code was called once' ); } # Check the hook remains in place SCOPE: { my $rv = Foo->new->bar; is( $rv, 'bar', 'Method now returns correctly' ); is( $around, 7, 'No additional calls made to the advice' ); is( $bar, 2, 'Calls are correctly kept with the Aspect' ); } # Check the simplest case of ->run_original method works. # Check nesting of aspect hooks (particularly expired ones). # Check complex nested pointcuts with the around method. SCOPE: { my $pointcut = call( qr/^Foo::\w+$/) & ! call( 'Foo::new' ); around { $around += 3; $_[0]->proceed; } $pointcut; my $object = Foo->new; isa_ok( $object, 'Foo' ); is( $around, 7, 'Constructor was not hooked in constructor' ); my $rv1 = $object->foo; my $rv2 = $object->bar; my $rv3 = $object->baz; is( $rv1, 'foo', 'Nested disabled around works' ); is( $rv2, 'bar', 'Nested active around works' ); is( $rv3, 'baz', 'Ordinary ->run_original works' ); is( $foo, 2, '->foo was called once' ); is( $bar, 3, '->bar was called once' ); is( $baz, 1, '->baz was called once' ); is( $around, 18, 'Advice code was called three times' ); } # Regression test for RT #63781 Could not get the return value SCOPE: { around { $_->proceed; is( $_->return_value, 'James Bond', '->return_value ok' ); } call qr/query_person/; is( query_person('007'), 'James Bond', 'Function returns ok', ); sub query_person { return 'James Bond'; } }