#!/usr/bin/perl

# Testing of the three wantarray-related pointcuts.
# Because each advice type generates different code,
# it's important to test with each different variation.

use strict;
BEGIN {
	$|  = 1;
	$^W = 1;
}

use Test::More tests => 37;
use Test::NoWarnings;
use Test::Exception;
use Aspect;

use vars qw{$COUNT};





######################################################################
# Wantarray with before() advice

# This also tests currying logic for and-nested negated wantarray pointcuts

$COUNT = 0;

before { $COUNT += 1      } call 'Foo::before_one'   & wantlist;
before { $COUNT += 10     } call 'Foo::before_two'   & wantscalar;
before { $COUNT += 100    } call 'Foo::before_three' & wantvoid;
before { $COUNT += 1000   } call 'Foo::before_four'  & ! wantlist;
before { $COUNT += 10000  } call 'Foo::before_five'  & ! wantscalar;
before { $COUNT += 100000 } call 'Foo::before_six'   & ! wantvoid;

SCOPE: {
	my @l = Foo::before_one();
	is( $COUNT, 1, 'Matched wantlist' );
	my $s = Foo::before_one();
	is( $COUNT, 1, 'Matched wantlist' );
	Foo::before_one();
	is( $COUNT, 1, 'Matched wantlist' );
}

SCOPE: {
	my @l = Foo::before_two();
	is( $COUNT, 1, 'Matched wantscalar' );
	my $s = Foo::before_two();
	is( $COUNT, 11, 'Matched wantscalar' );
	Foo::before_two();
	is( $COUNT, 11, 'Matched wantscalar' );
}

SCOPE: {
	my @l = Foo::before_three();
	is( $COUNT, 11, 'Matched wantvoid' );
	my $s = Foo::before_three();
	is( $COUNT, 11, 'Matched wantvoid' );
	Foo::before_three();
	is( $COUNT, 111, 'Matched wantvoid' );
}

SCOPE: {
	my @l = Foo::before_four();
	is( $COUNT, 111, 'Matched ! wantlist' );
	my $s = Foo::before_four();
	is( $COUNT, 1111, 'Matched ! wantlist' );
	Foo::before_four();
	is( $COUNT, 2111, 'Matched ! wantlist' );
}

SCOPE: {
	my @l = Foo::before_five();
	is( $COUNT, 12111, 'Matched ! wantscalar' );
	my $s = Foo::before_five();
	is( $COUNT, 12111, 'Matched ! wantscalar' );
	Foo::before_five();
	is( $COUNT, 22111, 'Matched ! wantscalar' );
}

SCOPE: {
	my @l = Foo::before_six();
	is( $COUNT, 122111, 'Matched ! wantvoid' );
	my $s = Foo::before_six();
	is( $COUNT, 222111, 'Matched ! wantvoid' );
	Foo::before_six();
	is( $COUNT, 222111, 'Matched ! wantvoid' );
}





######################################################################
# Wantarray with after() advice

$COUNT = 0;

after { $COUNT += 1      } call 'Foo::after_one'   & wantlist;
after { $COUNT += 10     } call 'Foo::after_two'   & wantscalar;
after { $COUNT += 100    } call 'Foo::after_three' & wantvoid;
after { $COUNT += 1000   } call 'Foo::after_four'  & wantlist;
after { $COUNT += 10000  } call 'Foo::after_five'  & wantscalar;
after { $COUNT += 100000 } call 'Foo::after_six'   & wantvoid;

SCOPE: {
	my @l = Foo::after_one();
	my $s = Foo::after_one();
	Foo::after_one();
}
is( $COUNT, 1, 'Matched wantlist' );

SCOPE: {
	my @l = Foo::after_two();
	my $s = Foo::after_two();
	Foo::after_two();
}
is( $COUNT, 11, 'Matched wantscalar' );

SCOPE: {
	my @l = Foo::after_three();
	my $s = Foo::after_three();
	Foo::after_three();
}
is( $COUNT, 111, 'Matched wantvoid' );

SCOPE: {
	throws_ok(
		sub { my @l = Foo::after_four(); },
		qr/four/,
		'after wantlist array'
	);
	throws_ok(
		sub { my $s = Foo::after_four(); },
		qr/four/,
		'after wantlist scalar'
	);
	throws_ok(
		sub { Foo::after_four(); },
		qr/four/,
		'after wantlist void'
	);
}
is( $COUNT, 1111, 'Matched wantlist' );

SCOPE: {
	throws_ok(
		sub { my @l = Foo::after_five(); },
		qr/five/,
		'after wantscalar array'
	);
	throws_ok(
		sub { my $s = Foo::after_five(); },
		qr/five/,
		'after wantscalar scalar'
	);
	throws_ok(
		sub { Foo::after_five(); },
		qr/five/,
		'after wantscalar void'
	);
}
is( $COUNT, 11111, 'Matched wantscalar' );

SCOPE: {
	throws_ok(
		sub { my @l = Foo::after_six(); },
		qr/six/,
		'after wantvoid array'
	);
	throws_ok(
		sub { my $s = Foo::after_six(); },
		qr/six/,
		'after wantvoid scalar'
	);
	throws_ok(
		sub { Foo::after_six(); },
		qr/six/,
		'after wantvoid void'
	);
}
is( $COUNT, 111111, 'Matched wantvoid' );





######################################################################
# Wantarray with around() advice

$COUNT = 0;

around { $COUNT += 1   } call 'Foo::around_one'   & wantlist;
around { $COUNT += 10  } call 'Foo::around_two'   & wantscalar;
around { $COUNT += 100 } call 'Foo::around_three' & wantvoid;

SCOPE: {
	my @l = Foo::around_one();
	my $s = Foo::around_one();
	Foo::around_one();
}
is( $COUNT, 1, 'Matched wantlist' );

SCOPE: {
	my @l = Foo::around_two();
	my $s = Foo::around_two();
	Foo::around_two();
}
is( $COUNT, 11, 'Matched wantscalar' );

SCOPE: {
	my @l = Foo::around_three();
	my $s = Foo::around_three();
	Foo::around_three();
}
is( $COUNT, 111, 'Matched wantvoid' );





######################################################################
# Support Methods

package Foo;

sub before_one            { 1 }

sub before_two            { 2 }

sub before_three          { 3 }

sub before_four           { 4 }

sub before_five           { 5 }

sub before_six            { 6 }

sub after_one             { 1 }

sub after_two             { 2 }

sub after_three           { 3 }

sub after_four            { die 'four' }

sub after_five            { die 'five' }

sub after_six             { die 'six'  }

sub around_one            { 1 }

sub around_two            { 2 }

sub around_three          { 3 }