view release on metacpan or  search on metacpan

t/24_advice_after.t  view on Meta::CPAN

	eval 'main::with_proto(1, 2)';
	like( $@, qr/Too many arguments/, 'prototypes are obeyed' );
}

# Confirm correct parameter error after hooking
SCOPE: {
	local $@;
	eval 'main::with_proto(1, 2)';
	like( $@, qr/Too many arguments/, 'prototypes are obeyed' );
}





######################################################################
# Caller Correctness

my @CALLER = ();
my $AFTER  = 0;

SCOPE: {
	# Set up the Aspect
	my $aspect = after { $AFTER++ } call qr/^My::Three::d?bar$/;
	isa_ok( $aspect, 'Aspect::Advice' );
	isa_ok( $aspect, 'Aspect::Advice::After' );
	is( $AFTER,          0, '$AFTER is false' );
	is( scalar(@CALLER), 0, '@CALLER is empty' );

	# Call a method above the wrapped method
	my $rv = My::Two->foo;
	is( $rv, 'value', '->foo is ok' );
	is( $AFTER,          1, '$AFTER is true' );
	is( scalar(@CALLER), 2, '@CALLER is full' );
	is( $CALLER[0]->[0], 'My::Two', 'First caller is My::Two' );
	is( $CALLER[1]->[0], 'main', 'Second caller is main' );

	# Call a method above the wrapped method
	throws_ok( sub { My::Two->dfoo }, qr/value/, '->foo is ok' );
	is( $AFTER,          2, '$AFTER is true' );
	is( scalar(@CALLER), 2, '@CALLER is full' );
	is( $CALLER[0]->[0], 'My::Two', 'First caller is My::Two' );
	is( $CALLER[1]->[0], 'main', 'Second caller is main' );
}

SCOPE: {
	package My::Two;

	sub foo {
		My::Three->bar;
	}

	sub dfoo {
		My::Three->dbar;
	}

	package My::Three;

	sub bar {
		@CALLER = (
			[ caller(0) ],
			[ caller(1) ],
		);
		return 'value';
	}

	sub dbar {
		@CALLER = (
			[ caller(0) ],
			[ caller(1) ],
		);
		die 'value';
	}
}





######################################################################
# Wantarray Support

our $THROW   = 0;
my @CONTEXT = ();

# Before the aspects
SCOPE: {
	() = Foo->after;
	my $dummy = Foo->after;
	Foo->after;

	local $THROW = 1;

	throws_ok(
		sub { () = Foo->after },
		qr/bang/,
		'after before throws ok',
	);
	throws_ok(
		sub { my $dummy = Foo->after },
		qr/bang/,
		'after before throws ok',
	);
	throws_ok(
		sub { Foo->after },
		qr/bang/,
		'after before throws ok',
	);
}

SCOPE: {
	my $aspect = after {
		if ( $_[0]->wantarray ) {
			push @CONTEXT, 'ARRAY';
		} elsif ( defined $_[0]->wantarray ) {
			push @CONTEXT, 'SCALAR';
		} else {
			push @CONTEXT, 'VOID';
		}
		if ( wantarray ) {
			push @CONTEXT, 'ARRAY';
		} elsif ( defined wantarray ) {
			push @CONTEXT, 'SCALAR';
		} else {
			push @CONTEXT, 'VOID';
		}
	} call 'Foo::after';

	# During the aspects
	() = Foo->after;