The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use lib qw/t lib/;
use warnings;
use strict;
use Test::More tests => 30;

use Games::Tournament::RoundRobin;

my @test_leagues = (
		[qw(Müller Meier)],
		[qw(Müller Meier Schulze)],
		[qw(Müller Meier Schulze Lehmann)],
		["Heinrich von Kleist", 
		 "D'Artagnan",
		 "Victor Hugo",
		 "Clemens Winkler",
		 "Leonardo Da Vinci"],
		['bla1',
		 'bla2',
		 'bla3',
		 'bla4',
		 'bla5',
		 'bla6',
		 'bla7',
		 'bla8',
		 'bla9',
		 'bla10'],
		);

for (@test_leagues) {
	&testing(@{ $_ });
}


sub testing {
	my @members = @_;
	my $members = @members;
	my %pairings;
	my $redcont;
	my $byecont;

	ok(my $tourn = Games::Tournament::RoundRobin->new(
				league => [ @members ]),
			"Creating new league with $members members.");
	my $rounds = $tourn->rounds();

	ok(my @sched = @{$tourn->byelessSchedule()},
			'Creating the schedule.');

	is(scalar(@sched), $rounds, 'Right number of rounds.');

	my %count_right; # the right number of appearances of the people
	for my $round (@sched) {
		for my $match ( @$round ) {
			my ( $member, $partner ) = @$match;
			$byecont++ if $member eq "Bye" or $partner eq "Bye";
			$count_right{$member}++;
			$count_right{$partner}++;
			$pairings{$member . $partner}++; # Any
			$pairings{$partner . $member}++; # redundant meetings?
		}
	}

	for (keys %pairings) {
		if ($pairings{$_} > 1) {$redcont++}
	}
	ok(! $redcont, 'No redundant meetings.');

	ok(! $byecont, 'No silly Bye member.');

	my $appearance_ok;
	for (@members) {
		if ($count_right{$_} == $members - 1) {++$appearance_ok}
	}
	is($appearance_ok, $members, "All appeared $rounds times.");
}