#!/usr/bin/perl
# vim: sw=2 ts=2 expandtab
#
# Runs the tests in various configurations
# To be started from the src/ directory, to have matching paths
#
# If there's an environment variable MAKEFLAGS set, and it includes a
# -j parameter, the tests are run in parallel. 
#
#
##########################################################################
# Copyright (C) 2005-2008 Philipp Marek.
#
# This program is free software;  you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 3 as
# published by the Free Software Foundation.
##########################################################################

use Encode qw(from_to);
use Fcntl qw(FD_CLOEXEC F_SETFD F_GETFD);
#

#############################################################################
# Detection and preparation
#############################################################################
{
  @locales=`locale -a`;
# look for UTF8
  ($utf8_locale)=grep(/\.utf-?8/i,@locales);
  chomp $utf8_locale;
# look for non-utf8
  ($loc_locale)=grep(!/(POSIX|C|utf-?8$)/i, @locales);
  chomp $loc_locale;

  ($cur_locale)=map { /LC_CTYPE="(.*)"/ ? ($1) : (); } `locale`;
  @test_locales=($utf8_locale, $loc_locale);
  ($cur_locale_norm = $cur_locale) =~ s#utf-8#utf8#i;
  push @test_locales, $cur_locale
    unless grep(lc($cur_locale_norm) eq lc($_), @test_locales);

  # Test the locales.
  ($utf8, $loc)=`make -C ../tests locale_strings BINARY=/bin/true`;
#  print $utf8,$loc;
  $target_enc="ISO-8859-1";
  from_to($utf8, "utf-8", $target_enc, Encode::FB_CROAK); 
  from_to($loc, $target_enc, "utf-8", Encode::FB_CROAK);
#  print $utf8,$loc; exit;


# Use special directories, so that normal system operation is not harmed.
  $PTESTBASE="/tmp/fsvs-tests-permutated";
  mkdir($PTESTBASE, 0777) || die $!
    if !-d $PTESTBASE;

  open(CSV, "> /tmp/fsvs-tests.csv") || die $!;
  select((select(CSV), $|=1)[0]);
  print CSV qq("Nr","Prot","LANG","priv","config","Result"\n);

# To get some meaningful test name outputted
  $ENV{"CURRENT_TEST"}="ext-tests";
  $start=time();

  $ENV{"MAKEFLAGS"} =~ /-j\s*(\d*)\b/;
  $parallel=$ENV{"PARALLEL"} || ($1+0) || 1;
  MSG("INFO", "Parallel found as $parallel") if $parallel;

# Used for status output
  $fail=0;
# Used for counting
  $sum=0;
# For parallel execution
  $running=0;

# Wait for children
  $SIG{"CHLD"}="DEFAULT";

  %results=();
  %pid_to_result=();

  MSG("INFO", StartText($start));

# We don't want no cache.
	$| =1;
}


#############################################################################
# Run the tests
#############################################################################
{
# My default is debug - so do that last, to have a 
# correctly configured environment :-)
# Furthermore the "unusual" configurations are done first.
#  for $release ("--enable-debug")
#  for $release ("--enable-release")
  for $release ("--with-waa_md5=8", "", "--enable-release", "--enable-debug")
  {
# make sure that the binary gets recompiled
    $conf_cmd="( cd .. && ./configure $release ) && ".
      "touch config.h && make -j$parallel";
    system("( $conf_cmd ) > /tmp/fsvs-conf.txt 2>&1") &&
         die "configure problem: $?";

# Start the slow, uncommon tasks first.
		for $prot ("svn+ssh", "file://")
		{
			for $user ("sudo", "")
			{
				for $lang (@test_locales)
				{
					$sum++;

# We have to make the conf and waa directory depend on the
# user, so that root and normal user don't share the same base -
# the user would get some EPERM.
# Furthermore parallel tests shouldn't collide.
          $PTESTBASE2="$PTESTBASE/u.$user" . ($parallel ? ".$sum" : "");

          # Start the test asynchronous, and wait if limit reached.
          $pid=StartTest();
          $running++;

          {
            my($tmp);
            $tmp="?";
            $results{$lang}{$user}{$prot}{$release}=\$tmp;
            $pid_to_result{$pid}=\$tmp;
          }


          WaitForChilds($parallel);
        }
      }
    }

# As we reconfigure on the next run, we have to wait for *all* pending 
# children.
    WaitForChilds(1);
  }
}

#############################################################################
# Summary
#############################################################################
{
  $end=time();
  MSG("INFO", EndText($start, $end));

  if ($fail)
  {
    MSG("ERROR","$fail of $sum tests failed.");
  }
  else
  {
    MSG("SUCCESS", "All $sum tests passed.");
  }

  close CSV;
}
  system qq(make gcov);
exit;


#############################################################################
# Functions
#############################################################################
sub MSG
{
  my($type, @text)=@_;
# We use the same shell functions, to get a nice consistent output.
  Bash(". ../tests/test_functions\n\$$type '" . join(" ",@text) . "'");
}


# Gets all parameters from global variables.
sub StartTest
{
	$pid=fork();
	die $! unless defined($pid);
	return $pid if ($pid);

#	$x=(0.5 < rand())+0; print "$$: exit with $x\n"; exit($x);

# this is the child ...
  pipe(FAILREAD, FAILWRITE) || die "pipe: $!";

# sudo closes the filehandles above 2, and I found no way to get it to 
# keep them open.
# So we have to give a path name to the children.
  $tl=$ENV{"TEST_LIST"};
	$parms="LANG=$lang" .
    " LC_MESSAGES=C" .
    " 'TESTBASEx=$PTESTBASE2'" .
    " 'PROTOCOL=$prot'" .
    " RANDOM_ORDER=1" .
    ($tl ? " 'TEST_LIST=$tl'" : "") .
    " TEST_FAIL_WRITE_HDL=/proc/$$/fd/".fileno(FAILWRITE) .
# And it can have our STDERR.
    " TEST_TTY_HDL=/proc/$$/fd/2";

# To avoid getting N*N running tasks for a "-j N", we explicitly say 1.
# Parallel execution within the tests is not done yet, but better safe 
# than sorry.
	$cmd="$user make run-tests -j1 $parms";

	$start=time();

# Output on STDOUT is short; the logfile says it all.
	print "#$sum ", StartText($start);

	open(LOG, "> /tmp/fsvs-test-$sum.log");
	select((select(LOG), $|=1)[0]);
	print LOG "Testing #$sum: (configure=$release) $parms\n",
				StartText($start),
				"\n$conf_cmd &&\n\t$cmd\n\n";

# The sources are already configured; just the tests have to be run.

	$pid=fork();
	die $! unless defined($pid);
	if (!$pid)
	{
    close FAILREAD;

		$ENV{"MAKEFLAGS"}="";

		open(STDIN, "< /dev/null") || die $!;
		open(STDOUT, ">&LOG") || die $!;
		open(STDERR, ">&LOG") || die $!;

    system("make -C ../tests diag BINARY=true LC_ALL=$lang");

    $x=fcntl(FAILWRITE, F_GETFD, 0);
    fcntl(FAILWRITE, F_SETFD, $x & ~FD_CLOEXEC);

# sudo removes some environment variables, so set all options via make.
		exec $cmd;
		die;
	}

  # Give the child some time to take the write side.
  # If we ever get more than 4/64 kB of failed tests this will hang.
	die $! if waitpid($pid, 0) == -1;
	$error=$?;

  # We have to close the write side of the pipe, so that on reading we'll 
  # see an EOF.
  close FAILWRITE;
  @failed=map { chomp; $_; } <FAILREAD>;
  close FAILREAD;


	$end=time();
	$t=EndText($start, $end);

	if ($error)
	{
		$status="FAIL";
		open(F, "< /proc/loadavg") && print(LOG "LoadAvg: ", <F>) && close(F);
		MSG("WARN", "#$sum failed; $t");
	}
	else
	{
		$status="OK";
		MSG("INFO", "#$sum done; $t");

		system("sudo rm -rf $PTESTBASE2");
	}

	print LOG "\n",
				"$t\n",
				"$status $error: $user $parms\n",
				"got failed as (", join(" ", @failed), ")\n",
				"\n",
				"$conf_cmd && $cmd\n";
	close LOG;

	$u = $user || "user";
  print CSV join(",", $sum, map { "'$_'"; } 
    ($prot, $lang, $u, $release, $status, sort(@failed))),
  "\n";
	close CSV;

# We cannot return $error directly ... only the low 8bit would 
# be taken, and these are the signal the process exited with.
# A normal error status would be discarded!
	exit($error ? 1 : 0);
}


sub WaitForChilds
{
	my($allowed)=@_;
	my($pid, $ret);

	while ($running >= $allowed)
	{
		$pid=wait();
		$ret=$?;
		die $! if $pid == -1;

		${$pid_to_result{$pid}}=$ret;
		$fail++ if $ret;
		$running--;
	}
}


# Some of the things done in via the shell only works with bash; since 
# debian has moved to dash recently, we make sure to use the correct 
# program.
sub Bash
{
  die unless @_ == 1;
  system '/bin/bash', '-c', @_;
}


# The \n don't matter for the shell, and they help for direct output.
sub StartText
{
	my($start)=@_;
	return "Started at (" . localtime($start) . ").\n";
}

sub EndText
{
	my($start, $end)=@_;
	return "Finished after ". ($end - $start) . " seconds (" . 
		localtime($end) . ").";
}
