path: root/compare_dg_tests.pl

#!/usr/bin/env perl
use strict;
use warnings;

use File::Glob;
use Getopt::Long;
use Term::ANSIColor qw(:constants);
use File::Basename;
use Cwd;

my $app = $0;

sub read_sum($);
sub read_unstable($);
sub dump_result($);
sub compare_results($$);
sub usage();
sub print_compare_results_summary($$);
sub nothing($$$$);

# OK
my $STILL_PASSES          = "Still passes              [PASS => PASS]";
my $STILL_FAILS           = "Still fails               [FAIL => FAIL]";
my $STILL_XPASS           = "Still xpass               [XPASS=>XPASS]";
my $STILL_XFAIL           = "Still xfail               [XFAIL=>XFAIL]";

# TO BE CHECKED
my $PASS_NOW_XFAIL        = "PASS now XFAIL            [PASS =>XFAIL]";
my $XFAIL_APPEARS         = "XFAIL appears             [     =>XFAIL]";
my $FAIL_NOW_XFAIL        = "FAIL now XFAIL            [FAIL =>XFAIL]";
my $XPASS_NOW_XFAIL       = "XPASS now XFAIL           [XPASS=>XFAIL]";
my $PASSED_NOW_TIMEOUTS   = "Timeout                   [PASS =>T.OUT]";
my $FAIL_DISAPPEARS	  = "FAIL disappears           [FAIL =>     ]";
my $XPASS_NOW_PASSES      = "XPASS now PASS            [XPASS=> PASS]";
my $XFAIL_NOW_PASSES      = "XFAIL now PASS            [XFAIL=> PASS]";
my $XFAIL_NOW_XPASS       = "XFAIL now XPASS           [XFAIL=>XPASS]";
my $FAIL_NOW_PASSES       = "FAIL now PASS             [FAIL => PASS]";
my $FAIL_NOW_XPASS        = "FAIL now XPASS            [FAIL =>XPASS]";
my $NEW_PASSES		  = "New PASS                  [     => PASS]";
my $UNHANDLED_CASES	  = "Unhandled cases           [   ..??..   ]";
my $UNSTABLE_CASES	  = "Unstable cases, ignored   [~RANDOM     ]";
my $UNSUPPORTED_XPASS     = "UNSUPPORTED now XPASS     [UNSUP=>XPASS]";
my $UNSUPPORTED_XFAIL     = "UNSUPPORTED now XFAIL     [UNSUP=>XFAIL]";
my $UNSUPPORTED_DISAPPEARS= "UNSUPPORTED disappears    [UNSUP=>     ]";
my $UNTESTED_PASS         = "UNTESTED now PASS         [UNTES=> PASS]";
my $UNTESTED_XFAIL        = "UNTESTED now XFAIL        [UNTES=>XFAIL]";
my $UNTESTED_DISAPPEARS   = "UNTESTED disappears       [UNTES=>     ]";
my $UNRESOLVED_PASS       = "UNRESOLVED now PASS       [UNRES=> PASS]";
my $UNRESOLVED_XFAIL      = "UNRESOLVED now XFAIL      [UNRES=>XFAIL]";
my $UNRESOLVED_DISAPPEARS = "UNRESOLVED disappears     [UNRES=>     ]";

# REGRESSIONS
my $PASS_NOW_XPASS        = "PASS now XPASS            [PASS =>XPASS]";
my $PASSED_NOW_FAILS      = "PASS now FAIL             [PASS => FAIL]";
my $PASS_DISAPPEARS       = "PASS disappears           [PASS =>     ]";
my $XPASS_DISAPPEARS      = "XPASS disappears          [XPASS=>     ]";
my $FAIL_APPEARS          = "FAIL appears              [     => FAIL]";
my $XPASS_APPEARS         = "XPASS appears             [     =>XPASS]";
my $XPASS_NOW_FAIL        = "XPASS now FAIL            [XPASS=> FAIL]";
my $XFAIL_NOW_FAIL        = "XFAIL now FAIL            [XFAIL=> FAIL]";
my $XFAIL_DISAPPEARS	  = "XFAIL disappears          [XFAIL=>     ]";

my $UNSUPPORTED_PASS      = "UNSUPPORTED now PASS      [UNSUP=> PASS]";
my $UNSUPPORTED_FAIL      = "UNSUPPORTED now FAIL      [UNSUP=> FAIL]";
my $UNTESTED_FAIL         = "UNTESTED now FAIL         [UNTES=> FAIL]";
my $UNTESTED_XPASS        = "UNTESTED now XPASS        [UNTES=>XPASS]";
my $UNRESOLVED_FAIL       = "UNRESOLVED now FAIL       [UNRES=> FAIL]";
my $UNRESOLVED_XPASS      = "UNRESOLVED now XPASS      [UNRES=>XPASS]";

my @handler_list = (
  {was=>"PASS",     is=>"PASS",     cat=>$STILL_PASSES},
  {was=>"PASS",     is=>"XPASS",    cat=>$PASS_NOW_XPASS},
  {was=>"XPASS",    is=>"PASS",     cat=>$XPASS_NOW_PASSES},
  {was=>"XPASS",    is=>"XPASS",    cat=>$STILL_XPASS},
  {was=>"FAIL",     is=>"FAIL",     cat=>$STILL_FAILS},
  {was=>"FAIL",     is=>"XFAIL",    cat=>$FAIL_NOW_XFAIL},
  {was=>"XFAIL",    is=>"FAIL",     cat=>$XFAIL_NOW_FAIL},
  {was=>"XFAIL",    is=>"XFAIL",    cat=>$STILL_XFAIL},

  {was=>"XPASS",    is=>"XFAIL",    cat=>$XPASS_NOW_XFAIL},
  {was=>"PASS",     is=>"XFAIL",    cat=>$PASS_NOW_XFAIL},
  {was=>"FAIL",     is=>"NO_EXIST", cat=>$FAIL_DISAPPEARS},
  {was=>"XFAIL",    is=>"NO_EXIST", cat=>$XFAIL_DISAPPEARS},
  {was=>"XFAIL",    is=>"PASS",     cat=>$XFAIL_NOW_PASSES},
  {was=>"XFAIL",    is=>"XPASS",    cat=>$XFAIL_NOW_XPASS},
  {was=>"FAIL",     is=>"PASS",     cat=>$FAIL_NOW_PASSES},
  {was=>"FAIL",     is=>"XPASS",    cat=>$FAIL_NOW_XPASS},
  {was=>"NO_EXIST", is=>"PASS",     cat=>$NEW_PASSES},
  {was=>"NO_EXIST", is=>"XPASS",    cat=>$XPASS_APPEARS},

  {was=>"PASS",     is=>"FAIL",     handler=>\&handle_pass_fail},
  {was=>"XPASS",    is=>"FAIL",     cat=>$XPASS_NOW_FAIL},
  {was=>"PASS",     is=>"NO_EXIST", cat=>$PASS_DISAPPEARS},
  {was=>"XPASS",    is=>"NO_EXIST", cat=>$XPASS_DISAPPEARS},
  {was=>"NO_EXIST", is=>"FAIL",     cat=>$FAIL_APPEARS},
  {was=>"NO_EXIST", is=>"XFAIL",    cat=>$XFAIL_APPEARS},

  {was=>"UNSUPPORTED", is=>"PASS", cat=>$UNSUPPORTED_PASS},
  {was=>"UNSUPPORTED", is=>"XPASS", cat=>$UNSUPPORTED_XPASS},
  {was=>"UNSUPPORTED", is=>"FAIL", cat=>$UNSUPPORTED_FAIL},
  {was=>"UNSUPPORTED", is=>"XFAIL", cat=>$UNSUPPORTED_XFAIL},
  {was=>"UNSUPPORTED", is=>"NO_EXIST", cat=>$UNSUPPORTED_DISAPPEARS},

  {was=>"UNTESTED", is=>"PASS", cat=>$UNTESTED_PASS},
  {was=>"UNTESTED", is=>"XPASS", cat=>$UNTESTED_XPASS},
  {was=>"UNTESTED", is=>"FAIL", cat=>$UNTESTED_FAIL},
  {was=>"UNTESTED", is=>"XFAIL", cat=>$UNTESTED_XFAIL},
  {was=>"UNTESTED", is=>"NO_EXIST", cat=>$UNTESTED_DISAPPEARS},

  {was=>"UNRESOLVED", is=>"PASS", cat=>$UNRESOLVED_PASS},
  {was=>"UNRESOLVED", is=>"XPASS", cat=>$UNRESOLVED_XPASS},
  {was=>"UNRESOLVED", is=>"FAIL", cat=>$UNRESOLVED_FAIL},
  {was=>"UNRESOLVED", is=>"XFAIL", cat=>$UNRESOLVED_XFAIL},
  {was=>"UNRESOLVED", is=>"NO_EXIST", cat=>$UNRESOLVED_DISAPPEARS},

#  {was=>"NO_EXIST", is=>"NO_EXIST", handler=>\&handle_not_yet_supported}
);

######################################################
# TREAT ARGUMENTS

my $verbose=0;
my $quiet=0;
my $long=0;
my $short=0;
my $debug=0;
my ($testroot, $basename);
my ($ref_file_name, $res_file_name);
my $nounstable=0;
my $unstablefile=0;
my @unstable_markers=();

GetOptions ("l"           => \$long,
            "s"           => \$short,
            "q"           => \$quiet,
            "v"           => \$verbose,
            "dbg"         => \$debug,
            "testroot=s"  => \$testroot,
            "basename=s"  => \$basename,
            "no-unstable"  => \$nounstable,
            "unstable-tests=s" => \$unstablefile,
            "unstable-marker=s"    => \@unstable_markers);

$ref_file_name = $ARGV[0] if ($#ARGV == 1);
$res_file_name = $ARGV[1] if ($#ARGV == 1);

$ref_file_name = $testroot."/expected_results/".$basename if ($testroot and $basename);
$res_file_name = $testroot."/testing/run/".$basename if ($testroot and $basename);
&usage if (not $ref_file_name or not $res_file_name);

my ($col_boldred, $col_red, $col_boldgreen, $col_green, $col_boldpink, $col_pink, $col_reset)
    = ("\033[31;1m","\033[31;3m","\033[32;1m","\033[32;3m","\033[35;1m","\033[35;2m","\033[0m");
($col_boldred, $col_red, $col_boldgreen, $col_green, $col_boldpink, $col_pink, $col_reset)
    = ("","","","","","","") if (not I_am_interactive());

######################################################
# MAIN PROGRAM
# print "comparing $ref_file_name $res_file_name\n";

# If none of the 2 .sum exists, nothing to compare: exit early.
exit 0 if ( (! -e $ref_file_name) && (! -e $res_file_name ));

my $ref = read_sum($ref_file_name) ;
my $res = read_sum($res_file_name) ;
my @unstablelist = ();

@unstablelist = read_unstable($unstablefile) if ($unstablefile ne 0);

compare_results($ref, $res);

my $final_result = print_compare_results_summary($ref, $res);

exit $final_result;

######################################################
# UTILITIES

sub empty_result()
{
   my %empty_result;# = {PASS=>0, FAIL=>0, XPASS=>0, XFAIL=>0, UNSUPPORTED=>0, UNTESTED=>0, UNRESOLVED=>0};
   $empty_result{PASS}=$empty_result{FAIL}=$empty_result{XPASS}=$empty_result{XFAIL}=0;
   $empty_result{UNSUPPORTED}=$empty_result{UNTESTED}=$empty_result{UNRESOLVED}=$empty_result{NO_EXIST}=0;
   return \%empty_result;
}
sub I_am_interactive {
  return -t STDIN && -t STDOUT;
}
sub usage()
{
	print "Usage : $app <ref_file.sum> <result_file.sum>\n";
	exit 1;
}


######################################################
# PARSING
sub read_sum($)
{
   my ($sum_file) = @_;
   my $res = empty_result();
   my %testcases;
   my %unsupported;
   $res->{testcases} = \%testcases;
   my $pending_timeout=0;

   $res->{EXEC}->{PASS} = 0;
   $res->{EXEC}->{FAIL} = 0;

   open SUMFILE, $sum_file or die $!;
   while (<SUMFILE>)
   {
	  if (m/^(PASS|XPASS|FAIL|XFAIL|UNSUPPORTED|UNTESTED|UNRESOLVED): (.*)/)
	  {
	  	my ($diag,$tc) = ($1,$2);
		my %tcresult;
		$tc =~ s/==[0-9]+== Shadow memory range interleaves with an existing memory mapping. ASan cannot proceed correctly./==<pid>== Shadow memory range interleaves with an existing memory mapping. ASan cannot proceed correctly./;
		$testcases{$tc} = empty_result() if (not exists $testcases{$tc});
		$testcases{$tc}->{$diag}++;
		$testcases{$tc}->{HAS_TIMED_OUT} = $pending_timeout;
		$pending_timeout = 0;
		$res->{$diag}++;
		# Count execution tests, for a sanity check
		if ($tc =~ /execution/)
		{
		    $res->{EXEC}->{$diag}++;
		}
	  }
	  elsif (m/WARNING: program timed out/) 
	  {
	  	$pending_timeout = 1;
	  }
	  elsif (m/^(# of expected passes|# of unexpected failures|# of expected failures|# of known failures|# of unsupported tests|# of untested testcases)\s+(.*)/)
	  {
	  	 $res->{"summary - "."$1"} = $2;
	  }
	  elsif (m/^\/.*\/([^\/]+)\s+version\s+(.*)/)
	  {
	  	 $res->{tool} = $1;
	  	 $res->{version} = $2;
		 $res->{version} =~ s/ [-(].*//;
	  }
   }
   close SUMFILE;
   return $res;
}

# Parse list on unstable tests
sub read_unstable($)
{
   my ($unstable_file) = @_;
   my @unstable_tests = ();

   open UNSTABLEFILE, $unstable_file or die $!;
   while (<UNSTABLEFILE>)
   {
       # Skip lines starting with '#', or with spaces only
       if ((/^#/) || (/^[ 	]*$/))
       {
       }
       else
       {
	   chomp;

	   my $test = $_;

	   # Check if line is of type: target:testname
	   if (/^(.*?):/)
	   {
	       foreach my $unstable_marker (@unstable_markers)
	       {
		   if ($unstable_marker eq $1) {
		       # If target matches the one supplied as script
		       # argument, add the testname to the list
		       $test =~ s/.*?://;
		       push @unstable_tests, $test;
		   }
	       }
	   } else {
	       push @unstable_tests, $test;
	   }
       }
   }
   close UNSTABLEFILE;
   return @unstable_tests;
}

######################################################
# DIFFING
sub handle_pass_fail($$$$)
{
   my ($ref, $res, $diag_diag, $tc) = @_;
   if ($res->{testcases}->{$tc}->{HAS_TIMED_OUT})
   {
     push @{$res->{$PASSED_NOW_TIMEOUTS}}, $tc;
   }
   else
   {
     push @{$res->{$PASSED_NOW_FAILS}}, $tc;
   }
}

sub compare_results($$)
{
   my ($ref, $res) = @_;

   @{$res->{$STILL_PASSES}} = ();
   @{$res->{$STILL_FAILS}} = ();
   @{$res->{$STILL_XPASS}} = ();
   @{$res->{$PASSED_NOW_FAILS}} = ();
   @{$res->{$XPASS_NOW_FAIL}} = ();
   @{$res->{$PASS_DISAPPEARS}} = ();
   @{$res->{$XPASS_DISAPPEARS}} = ();
   @{$res->{$FAIL_APPEARS}} = ();
   @{$res->{$XPASS_APPEARS}} = ();
   @{$res->{$NEW_PASSES}} = ();
   @{$res->{$FAIL_DISAPPEARS}} = ();
   @{$res->{$XFAIL_DISAPPEARS}} = ();
   @{$res->{$XFAIL_APPEARS}} = ();
   @{$res->{$FAIL_NOW_XFAIL}} = ();
   @{$res->{$PASS_NOW_XFAIL}} = ();
   @{$res->{$XPASS_NOW_XFAIL}} = ();
   @{$res->{$XPASS_APPEARS}} = ();
   @{$res->{$PASS_NOW_XPASS}} = ();
   @{$res->{$XPASS_NOW_PASSES}} = ();
   @{$res->{$XFAIL_NOW_PASSES}} = ();
   @{$res->{$XFAIL_NOW_XPASS}} = ();
   @{$res->{$XFAIL_NOW_FAIL}} = ();
   @{$res->{$FAIL_NOW_PASSES}} = ();
   @{$res->{$FAIL_NOW_XPASS}} = ();
   @{$res->{$PASSED_NOW_TIMEOUTS}} = ();
   @{$res->{$UNSUPPORTED_PASS}} = ();
   @{$res->{$UNSUPPORTED_XPASS}} = ();
   @{$res->{$UNSUPPORTED_FAIL}} = ();
   @{$res->{$UNSUPPORTED_XFAIL}} = ();
   @{$res->{$UNSUPPORTED_DISAPPEARS}} = ();
   @{$res->{$UNTESTED_PASS}} = ();
   @{$res->{$UNTESTED_XPASS}} = ();
   @{$res->{$UNTESTED_FAIL}} = ();
   @{$res->{$UNTESTED_XFAIL}} = ();
   @{$res->{$UNTESTED_DISAPPEARS}} = ();
   @{$res->{$UNRESOLVED_PASS}} = ();
   @{$res->{$UNRESOLVED_XPASS}} = ();
   @{$res->{$UNRESOLVED_FAIL}} = ();
   @{$res->{$UNRESOLVED_XFAIL}} = ();
   @{$res->{$UNRESOLVED_DISAPPEARS}} = ();
   @{$res->{$UNHANDLED_CASES}} = ();
   @{$res->{$UNSTABLE_CASES}} = ();

   #### MERGE REF AND RES
   foreach my $key (sort (keys %{$res->{testcases}}))
   {
		if (not exists $ref->{testcases}->{$key}) {
		   $ref->{testcases}->{$key} = empty_result();
		   $ref->{testcases}->{$key}->{NO_EXIST} = 1;
		}
   }
   foreach my $key (keys %{$ref->{testcases}})
   {
   		if (not exists $res->{testcases}->{$key})
		{
		   $res->{testcases}->{$key} = empty_result();
		   $res->{testcases}->{$key}->{NO_EXIST} = 1;
		}
   }

   #### ACTIONS FOR EACH CASES
   my %unstable_found;

   foreach my $key (sort (keys %{$ref->{testcases}}))
   {
       foreach my $diag_diag (@handler_list)
       {
	   if ($ref->{testcases}->{$key}->{$diag_diag->{was}} != $res->{testcases}->{$key}->{$diag_diag->{was}}
	       and $res->{testcases}->{$key}->{$diag_diag->{is}})
	   {
	       # If testcase is listed as 'unstable' mark it as
	       # such and skip other processing.
	       {
		   if (grep { (index $key,$_)!=-1} @unstablelist)
		   {
		       print "[unstable] $key\n" if ($debug);
		       $unstable_found{$key}=1;
		   }
		   else {
		       print "[$diag_diag->{was} => $diag_diag->{is}] $key\n" if ($debug);
		       if ($diag_diag->{handler})
		       {
			   $diag_diag->{handler} ($ref, $res, $diag_diag, $key);
		       }
		       else
		       {
			   push @{$res->{$diag_diag->{cat}}}, $key;
		       }
		   }
	       }
	   }
       }
   }
   push @{$res->{$UNSTABLE_CASES}}, (sort (keys (%unstable_found)))  if ($nounstable == 0);

}

######################################################
# PRINTING
sub print_tclist($@)
{
   my ($cat, @tclist) = @_;
   print "  - ".$cat.":\n\n  ". join("\n  ",@tclist) . "\n\n" if (scalar(@tclist));
}

sub print_compare_results_summary($$)
{
   my ($ref, $res) = @_;
   my $return_value=0;
   my $total_better = 0;
   my $rtotal = 0;
   my $quiet_reg = $quiet;
   my $ref_ratio = 0;
   my $res_ratio = 0;
   my $ratio_thresh = 0.95; # Warn if pass ratio is below this threshold
   my $ignore_exec = 0;
   my $ref_has_exec_tests = 0;
   my $res_has_exec_tests = 0;

   # Compute the pass ratio as a sanity check
   $ref_ratio = ($ref->{PASS} + $ref->{XFAIL}) /
       ($ref->{PASS} + $ref->{XFAIL}
	+ $ref->{XPASS} + $ref->{FAIL}
	+ $ref->{UNRESOLVED}
	+ $ref->{UNSUPPORTED}
	+ $ref->{UNTESTED});
   $res_ratio = ($res->{PASS} + $res->{XFAIL}) /
       ($res->{PASS} + $res->{XFAIL}
	+ $res->{XPASS} + $res->{FAIL}
	+ $res->{UNRESOLVED}
	+ $res->{UNSUPPORTED}
	+ $res->{UNTESTED});

   if (not $quiet)
   {
       printf "Comparing:\n";
       printf "REFERENCE:$ref_file_name\n";
       printf "CURRENT:  $res_file_name\n\n";
   }

   #### TESTS STATUS
   if (not $quiet and not $short)
   {
       printf "              `                              +---------+---------+\n";
       printf "o  RUN STATUS:                               |   REF   |   RES   |\n";
       printf "  +------------------------------------------+---------+---------+\n";
       printf "  | %-40s | %7d | %7d |\n", "Passes                            [PASS]", $ref->{PASS}, $res->{PASS};
       printf "  | %-40s | %7d | %7d |\n", "Unexpected fails                  [FAIL]", $ref->{FAIL}, $res->{FAIL};
       printf "  | %-40s | %7d | %7d |\n", "Unexpected passes                [XPASS]", $ref->{XPASS}, $res->{XPASS};
       printf "  | %-40s | %7d | %7d |\n", "Expected fails                   [XFAIL]", $ref->{XFAIL}, $res->{XFAIL};
       printf "  | %-40s | %7d | %7d |\n", "Unresolved                  [UNRESOLVED]", $ref->{UNRESOLVED}, $res->{UNRESOLVED};
       printf "  | %-40s | %7d | %7d |\n", "Unsupported                [UNSUPPORTED]", $ref->{UNSUPPORTED}, $res->{UNSUPPORTED};
       printf "  | %-40s | %7d | %7d |\n", "Untested                      [UNTESTED]", $ref->{UNTESTED}, $res->{UNTESTED};
       printf "  +------------------------------------------+---------+---------+\n";
       printf "\n";

       printf "    REF PASS ratio: %.2f\n", $ref_ratio;
       printf "    RES PASS ratio: %.2f\n", $res_ratio;
       if ($ref_ratio < $ratio_thresh)
       {
	   printf "    ***** ERROR: REF PASS ratio is abnormally low *****\n";
       }
       if ($res_ratio < $ratio_thresh)
       {
	   printf "    ***** ERROR: RES PASS ratio is abnormally low *****\n";
       }

       # If both PASS and FAIL EXEC tests are zero, assume there is no
       # execution test for this tool, and do not warn.
       $ref_has_exec_tests = ($ref->{EXEC}->{PASS} + $ref->{EXEC}->{FAIL}) != 0;
       if ($ref_has_exec_tests)
       {
	   printf "    ***** ERROR: No REF execution test PASSed. Check execution engine configuration. *****\n" if ($ref->{EXEC}->{PASS} == 0);
	   printf "    ***** WARNING: No REF execution test FAILed. Check execution engine configuration. *****\n" if ($ref->{EXEC}->{FAIL} == 0);
       }

       $res_has_exec_tests = ($res->{EXEC}->{PASS} + $res->{EXEC}->{FAIL}) != 0;
       if ($res_has_exec_tests)
       {
	   printf "    ***** ERROR: No RES execution test PASSed. Check execution engine configuration. *****\n" if ($res->{EXEC}->{PASS} == 0);
	   printf "    ***** WARNING: No RES execution test FAILed. Check execution engine configuration. *****\n" if ($res->{EXEC}->{FAIL} == 0);
       }

       # Ignore number of execution tests when computing the return
       # value, if both REF and RES have no execution test.
       $ignore_exec = !$ref_has_exec_tests && !$res_has_exec_tests;
   }

   #### REGRESSIONS ?
   $rtotal = scalar(@{$res->{$PASSED_NOW_FAILS}})
       +scalar(@{$res->{$XPASS_NOW_FAIL}})
       +scalar(@{$res->{$PASS_DISAPPEARS}})
       +scalar(@{$res->{$XPASS_DISAPPEARS}})
       +scalar(@{$res->{$FAIL_APPEARS}})
       +scalar(@{$res->{$XPASS_APPEARS}})
       +scalar(@{$res->{$PASS_NOW_XPASS}})
       +scalar(@{$res->{$XFAIL_NOW_FAIL}})
       +scalar(@{$res->{$XFAIL_DISAPPEARS}})
       +scalar(@{$res->{$UNSUPPORTED_FAIL}})
       +scalar(@{$res->{$UNSUPPORTED_XPASS}})
       +scalar(@{$res->{$UNTESTED_FAIL}})
       +scalar(@{$res->{$UNTESTED_XPASS}})
       +scalar(@{$res->{$UNRESOLVED_FAIL}})
       +scalar(@{$res->{$UNRESOLVED_XPASS}})
       +scalar(@{$res->{$PASSED_NOW_TIMEOUTS}});

   $quiet_reg=1 if ($short and not $rtotal);

   if (not $quiet_reg)
   {
       printf "\n$col_red"."o  REGRESSIONS:\n";
       printf "  +------------------------------------------+---------+\n";
       printf "  | %-40s | %7d |\n", $PASSED_NOW_FAILS, scalar(@{$res->{$PASSED_NOW_FAILS}}) if (scalar(@{$res->{$PASSED_NOW_FAILS}}));
       printf "  | %-40s | %7d |\n", $XPASS_NOW_FAIL, scalar(@{$res->{$XPASS_NOW_FAIL}}) if (scalar(@{$res->{$XPASS_NOW_FAIL}}));
       printf "  | %-40s | %7d |\n", $PASS_DISAPPEARS, scalar(@{$res->{$PASS_DISAPPEARS}}) if (scalar(@{$res->{$PASS_DISAPPEARS}}));
       printf "  | %-40s | %7d |\n", $XPASS_DISAPPEARS, scalar(@{$res->{$XPASS_DISAPPEARS}}) if (scalar(@{$res->{$XPASS_DISAPPEARS}}));
       printf "  | %-40s | %7d |\n", $FAIL_APPEARS, scalar(@{$res->{$FAIL_APPEARS}}) if (scalar(@{$res->{$FAIL_APPEARS}}));
       printf "  | %-40s | %7d |\n", $XPASS_APPEARS, scalar(@{$res->{$XPASS_APPEARS}}) if (scalar(@{$res->{$XPASS_APPEARS}}));
       printf "  | %-40s | %7d |\n", $PASS_NOW_XPASS, scalar(@{$res->{$PASS_NOW_XPASS}}) if (scalar(@{$res->{$PASS_NOW_XPASS}}));
       printf "  | %-40s | %7d |\n", $XFAIL_NOW_FAIL, scalar(@{$res->{$XFAIL_NOW_FAIL}}) if (scalar(@{$res->{$XFAIL_NOW_FAIL}}));
       printf "  | %-40s | %7d |\n", $XFAIL_DISAPPEARS, scalar(@{$res->{$XFAIL_DISAPPEARS}}) if (scalar(@{$res->{$XFAIL_DISAPPEARS}}));
       printf "  | %-40s | %7d |\n", $UNSUPPORTED_FAIL, scalar(@{$res->{$UNSUPPORTED_FAIL}}) if (scalar(@{$res->{$UNSUPPORTED_FAIL}}));
       printf "  | %-40s | %7d |\n", $UNSUPPORTED_XPASS, scalar(@{$res->{$UNSUPPORTED_XPASS}}) if (scalar(@{$res->{$UNSUPPORTED_XPASS}}));
       printf "  | %-40s | %7d |\n", $UNTESTED_FAIL, scalar(@{$res->{$UNTESTED_FAIL}}) if (scalar(@{$res->{$UNTESTED_FAIL}}));
       printf "  | %-40s | %7d |\n", $UNTESTED_XPASS, scalar(@{$res->{$UNTESTED_XPASS}}) if (scalar(@{$res->{$UNTESTED_XPASS}}));
       printf "  | %-40s | %7d |\n", $UNRESOLVED_FAIL, scalar(@{$res->{$UNRESOLVED_FAIL}}) if (scalar(@{$res->{$UNRESOLVED_FAIL}}));
       printf "  | %-40s | %7d |\n", $UNRESOLVED_XPASS, scalar(@{$res->{$UNRESOLVED_XPASS}}) if (scalar(@{$res->{$UNRESOLVED_XPASS}}));
       printf "  | %-40s | %7d |\n", $PASSED_NOW_TIMEOUTS, scalar(@{$res->{$PASSED_NOW_TIMEOUTS}}) if (scalar(@{$res->{$PASSED_NOW_TIMEOUTS}}));
       printf "  +------------------------------------------+---------+\n";
       printf "  | %-40s | %7d |\n", "TOTAL_REGRESSIONS", $rtotal;
       printf "  +------------------------------------------+---------+\n";
       printf "\n";

       if ($long)
       {
	      print_tclist($PASSED_NOW_FAILS, @{$res->{$PASSED_NOW_FAILS}});
	      print_tclist($XPASS_NOW_FAIL, @{$res->{$XPASS_NOW_FAIL}});
	      print_tclist($PASS_DISAPPEARS, @{$res->{$PASS_DISAPPEARS}});
	      print_tclist($XPASS_DISAPPEARS, @{$res->{$XPASS_DISAPPEARS}});
	      print_tclist($FAIL_APPEARS, @{$res->{$FAIL_APPEARS}});
	      print_tclist($XPASS_APPEARS, @{$res->{$XPASS_APPEARS}});
	      print_tclist($PASS_NOW_XPASS, @{$res->{$PASS_NOW_XPASS}});
	      print_tclist($XFAIL_NOW_FAIL, @{$res->{$XFAIL_NOW_FAIL}});
	      print_tclist($XFAIL_DISAPPEARS, @{$res->{$XFAIL_DISAPPEARS}});
	      print_tclist($UNSUPPORTED_FAIL, @{$res->{$UNSUPPORTED_FAIL}});
	      print_tclist($UNSUPPORTED_XPASS, @{$res->{$UNSUPPORTED_XPASS}});
	      print_tclist($UNTESTED_FAIL, @{$res->{$UNTESTED_FAIL}});
	      print_tclist($UNTESTED_XPASS, @{$res->{$UNTESTED_XPASS}});
	      print_tclist($UNRESOLVED_FAIL, @{$res->{$UNRESOLVED_FAIL}});
	      print_tclist($UNRESOLVED_XPASS, @{$res->{$UNRESOLVED_XPASS}});
	      print_tclist($PASSED_NOW_TIMEOUTS, @{$res->{$PASSED_NOW_TIMEOUTS}});
       }
       printf "$col_reset\n";
   }

   #### MINOR TO BE CHECKED ?
   if (not $quiet and not $short)
   {
       $total_better = scalar(@{$res->{$XPASS_NOW_PASSES}})+
	   scalar(@{$res->{$XFAIL_NOW_PASSES}})+
	   scalar(@{$res->{$XFAIL_NOW_XPASS}})+
	   scalar(@{$res->{$FAIL_NOW_PASSES}})+
	   scalar(@{$res->{$FAIL_NOW_XPASS}})+
	   scalar(@{$res->{$NEW_PASSES}})+
	   scalar(@{$res->{$FAIL_DISAPPEARS}})+
	   scalar(@{$res->{$XFAIL_APPEARS}})+
	   scalar(@{$res->{$FAIL_NOW_XFAIL}})+
	   scalar(@{$res->{$PASS_NOW_XFAIL}})+
	   scalar(@{$res->{$XPASS_NOW_XFAIL}})+
	   scalar(@{$res->{$UNSUPPORTED_PASS}})+
	   scalar(@{$res->{$UNSUPPORTED_XFAIL}})+
	   scalar(@{$res->{$UNSUPPORTED_DISAPPEARS}})+
	   scalar(@{$res->{$UNTESTED_PASS}})+
	   scalar(@{$res->{$UNTESTED_XFAIL}})+
	   scalar(@{$res->{$UNTESTED_DISAPPEARS}})+
	   scalar(@{$res->{$UNRESOLVED_PASS}})+
	   scalar(@{$res->{$UNRESOLVED_XFAIL}})+
	   scalar(@{$res->{$UNRESOLVED_DISAPPEARS}})+
	   scalar(@{$res->{$UNHANDLED_CASES}});

       printf "$col_pink"."o  MINOR TO BE CHECKED:\n";
       printf "  +------------------------------------------+---------+\n";
       printf "  | %-40s | %7d |\n", $XFAIL_APPEARS, scalar(@{$res->{$XFAIL_APPEARS}}) if (scalar(@{$res->{$XFAIL_APPEARS}}));
       printf "  | %-40s | %7d |\n", $FAIL_NOW_XFAIL, scalar(@{$res->{$FAIL_NOW_XFAIL}}) if (scalar(@{$res->{$FAIL_NOW_XFAIL}}));
       printf "  | %-40s | %7d |\n", $PASS_NOW_XFAIL, scalar(@{$res->{$PASS_NOW_XFAIL}}) if (scalar(@{$res->{$PASS_NOW_XFAIL}}));
       printf "  | %-40s | %7d |\n", $XPASS_NOW_XFAIL, scalar(@{$res->{$XPASS_NOW_XFAIL}}) if (scalar(@{$res->{$XPASS_NOW_XFAIL}}));
       printf "  | %-40s | %7d |\n", $FAIL_DISAPPEARS, scalar(@{$res->{$FAIL_DISAPPEARS}}) if (scalar(@{$res->{$FAIL_DISAPPEARS}}));
       printf "  | %-40s | %7d |\n", $XPASS_NOW_PASSES, scalar(@{$res->{$XPASS_NOW_PASSES}}) if (scalar(@{$res->{$XPASS_NOW_PASSES}}));
       printf "  | %-40s | %7d |\n", $XFAIL_NOW_PASSES, scalar(@{$res->{$XFAIL_NOW_PASSES}}) if (scalar(@{$res->{$XFAIL_NOW_PASSES}}));
       printf "  | %-40s | %7d |\n", $XFAIL_NOW_XPASS, scalar(@{$res->{$XFAIL_NOW_XPASS}}) if (scalar(@{$res->{$XFAIL_NOW_XPASS}}));
       printf "  | %-40s | %7d |\n", $FAIL_NOW_PASSES, scalar(@{$res->{$FAIL_NOW_PASSES}}) if (scalar(@{$res->{$FAIL_NOW_PASSES}}));
       printf "  | %-40s | %7d |\n", $FAIL_NOW_XPASS, scalar(@{$res->{$FAIL_NOW_XPASS}}) if (scalar(@{$res->{$FAIL_NOW_XPASS}}));
       printf "  | %-40s | %7d |\n", $NEW_PASSES, scalar(@{$res->{$NEW_PASSES}}) if (scalar(@{$res->{$NEW_PASSES}}));
       printf "  | %-40s | %7d |\n", $UNSUPPORTED_PASS, scalar(@{$res->{$UNSUPPORTED_PASS}}) if (scalar(@{$res->{$UNSUPPORTED_PASS}}));
       printf "  | %-40s | %7d |\n", $UNSUPPORTED_XFAIL, scalar(@{$res->{$UNSUPPORTED_XFAIL}}) if (scalar(@{$res->{$UNSUPPORTED_XFAIL}}));
       printf "  | %-40s | %7d |\n", $UNSUPPORTED_DISAPPEARS, scalar(@{$res->{$UNSUPPORTED_DISAPPEARS}}) if (scalar(@{$res->{$UNSUPPORTED_DISAPPEARS}}));
       printf "  | %-40s | %7d |\n", $UNTESTED_PASS, scalar(@{$res->{$UNTESTED_PASS}}) if (scalar(@{$res->{$UNTESTED_PASS}}));
       printf "  | %-40s | %7d |\n", $UNTESTED_XFAIL, scalar(@{$res->{$UNTESTED_XFAIL}}) if (scalar(@{$res->{$UNTESTED_XFAIL}}));
       printf "  | %-40s | %7d |\n", $UNTESTED_DISAPPEARS, scalar(@{$res->{$UNTESTED_DISAPPEARS}}) if (scalar(@{$res->{$UNTESTED_DISAPPEARS}}));
       printf "  | %-40s | %7d |\n", $UNRESOLVED_PASS, scalar(@{$res->{$UNRESOLVED_PASS}}) if (scalar(@{$res->{$UNRESOLVED_PASS}}));
       printf "  | %-40s | %7d |\n", $UNRESOLVED_XFAIL, scalar(@{$res->{$UNRESOLVED_XFAIL}}) if (scalar(@{$res->{$UNRESOLVED_XFAIL}}));
       printf "  | %-40s | %7d |\n", $UNRESOLVED_DISAPPEARS, scalar(@{$res->{$UNRESOLVED_DISAPPEARS}}) if (scalar(@{$res->{$UNRESOLVED_DISAPPEARS}}));
       printf "  | %-40s | %7d |\n", $UNHANDLED_CASES, scalar(@{$res->{$UNHANDLED_CASES}}) if (scalar(@{$res->{$UNHANDLED_CASES}}));
       printf "  | %-40s | %7d |\n", $UNSTABLE_CASES, scalar(@{$res->{$UNSTABLE_CASES}}) if (scalar(@{$res->{$UNSTABLE_CASES}}));
       printf "  +------------------------------------------+---------+\n";
       printf "  | %-40s | %7d |\n", "TOTAL_MINOR_TO_BE_CHECKED", $total_better + scalar(@{$res->{$UNSTABLE_CASES}});;
       printf "  +------------------------------------------+---------+\n";
       printf "\n";

       if ($long)
       {
	      print_tclist($XPASS_NOW_PASSES, @{$res->{$XPASS_NOW_PASSES}});
	      print_tclist($XFAIL_NOW_PASSES, @{$res->{$XFAIL_NOW_PASSES}});
	      print_tclist($XFAIL_NOW_XPASS, @{$res->{$XFAIL_NOW_XPASS}});
	      print_tclist($FAIL_NOW_PASSES, @{$res->{$FAIL_NOW_PASSES}});
	      print_tclist($FAIL_NOW_XPASS, @{$res->{$FAIL_NOW_XPASS}});
	      print_tclist($FAIL_DISAPPEARS, @{$res->{$FAIL_DISAPPEARS}});
	      print_tclist($XFAIL_APPEARS, @{$res->{$XFAIL_APPEARS}});
	      print_tclist($FAIL_NOW_XFAIL, @{$res->{$FAIL_NOW_XFAIL}});
	      print_tclist($PASS_NOW_XFAIL, @{$res->{$PASS_NOW_XFAIL}});
	      print_tclist($XPASS_NOW_XFAIL, @{$res->{$XPASS_NOW_XFAIL}});
	      print_tclist($UNHANDLED_CASES, @{$res->{$UNHANDLED_CASES}});
	      print_tclist($UNSUPPORTED_PASS, @{$res->{$UNSUPPORTED_PASS}});
	      print_tclist($UNSUPPORTED_XFAIL, @{$res->{$UNSUPPORTED_XFAIL}});
	      print_tclist($UNSUPPORTED_DISAPPEARS, @{$res->{$UNSUPPORTED_DISAPPEARS}});
	      print_tclist($UNTESTED_PASS, @{$res->{$UNTESTED_PASS}});
	      print_tclist($UNTESTED_XFAIL, @{$res->{$UNTESTED_XFAIL}});
	      print_tclist($UNTESTED_DISAPPEARS, @{$res->{$UNTESTED_DISAPPEARS}});
	      print_tclist($UNRESOLVED_PASS, @{$res->{$UNRESOLVED_PASS}});
	      print_tclist($UNRESOLVED_XFAIL, @{$res->{$UNRESOLVED_XFAIL}});
	      print_tclist($UNRESOLVED_DISAPPEARS, @{$res->{$UNRESOLVED_DISAPPEARS}});
	      print_tclist($UNSTABLE_CASES, @{$res->{$UNSTABLE_CASES}});
	      print_tclist($NEW_PASSES, @{$res->{$NEW_PASSES}});
       }
       printf "$col_reset\n";
   }

   $return_value = 1 if ($total_better);

   $return_value = 2 if ($rtotal);

   # Error if there was no PASS (eg when sth went wrong and no .sum was generated)
   $return_value = 2 if (($res->{PASS} + $res->{XFAIL}) == 0);

   # Error if every test passed, or the ratio was too low. This
   # generally means the simulator is not configured well.
   $return_value = 2 if (($ref_ratio == 100) || ($ref_ratio < $ratio_thresh));
   $return_value = 2 if (($res_ratio == 100) || ($res_ratio < $ratio_thresh));

   # Error if no execution test passed.
   # It is possible that no execution test fails, though.
   $return_value = 2 if (($ignore_exec == 0)
			 && (($ref->{EXEC}->{PASS} == 0)
			     || ($res->{EXEC}->{PASS} == 0)));

   return $return_value;
}