WL #5680 MTR results written to file with well defined format

Added --result-file option, which will produce var/mtr-results.txt
Output has a simple format:

<tag> : <value>  for general info on test run
{
  <tag> : <value>
  ....
}                for each test

Output from failed tests are included but may be truncated.
See WL for more details.

mysql-test/lib/My/CoreDump.pm

 # -*- cperl -*-
-# Copyright (C) 2008 MySQL AB, 2009 Sun Microsystems, Inc.
+# Copyright (c) 2008, 2011, Oracle and/or its affiliates. All rights reserved.
 #
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
@@ -21,6 +21,7 @@ use Carp;
 use My::Platform;
 
 use File::Temp qw/ tempfile tempdir /;
+use mtr_results;
 
 my $hint_mysqld;		# Last resort guess for executable path
 
@@ -80,7 +81,7 @@ sub _gdb {
   return if $? >> 8;
   return unless $gdb_output;
 
-  print <<EOF, $gdb_output, "\n";
+  resfile_print <<EOF, $gdb_output, "\n";
 Output from gdb follows. The first stack trace is from the failing thread.
 The following stack traces are from all threads (so the failing one is
 duplicated).
@@ -124,7 +125,7 @@ sub _dbx {
   return if $? >> 8;
   return unless $dbx_output;
 
-  print <<EOF, $dbx_output, "\n";
+  resfile_print <<EOF .  $dbx_output . "\n";
 Output from dbx follows. Stack trace is printed for all threads in order,
 above this you should see info about which thread was the failing one.
 ----------------------------
@@ -244,7 +245,7 @@ sub _cdb {
   $cdb_output=~ s/^Child\-SP          RetAddr           Call Site//gm;
   $cdb_output=~ s/\+0x([0-9a-fA-F]+)//gm;
   
-  print <<EOF, $cdb_output, "\n";
+  resfile_print <<EOF, $cdb_output, "\n";
 Output from cdb follows. Faulting thread is printed twice,with and without function parameters
 Search for STACK_TEXT to see the stack trace of 
 the faulting thread. Callstacks of other threads are printed after it.

mysql-test/lib/My/Test.pm

 # -*- cperl -*-
-# Copyright (C) 2008 MySQL AB
-#
+# Copyright (c) 2008, 2011, Oracle and/or its affiliates. All rights reserved.
+# 
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
 # the Free Software Foundation; version 2 of the License.
@@ -23,6 +23,7 @@ package My::Test;
 use strict;
 use warnings;
 use Carp;
+use mtr_results;
 
 
 sub new {
@@ -66,9 +67,26 @@ sub is_failed {
 }
 
 
+my %result_names= (
+		   'MTR_RES_PASSED'   =>  'pass',
+		   'MTR_RES_FAILED'   =>  'fail',
+		   'MTR_RES_SKIPPED'  =>  'skipped',
+		  );
+
 sub write_test {
   my ($test, $sock, $header)= @_;
 
+  if ($::opt_resfile && defined $test->{'result'}) {
+    resfile_test_info("result", $result_names{$test->{'result'}});
+    if ($test->{'timeout'}) {
+      resfile_test_info("comment", "Timeout");
+    } elsif (defined $test->{'comment'}) {
+      resfile_test_info("comment", $test->{'comment'});
+    }
+    resfile_test_info("result", "warning") if defined $test->{'check'};
+    resfile_to_test($test);
+  }
+
   # Give the test a unique key before serializing it
   $test->{key}= "$test" unless defined $test->{key};
 
@@ -113,6 +131,7 @@ sub read_test {
       $test->{$key}= _decode($value);
     }
   }
+  resfile_from_test($test) if $::opt_resfile;
   return $test;
 }
 

mysql-test/lib/mtr_report.pm

@@ -34,6 +34,7 @@ use My::Platform;
 use POSIX qw[ _exit ];
 use IO::Handle qw[ flush ];
 require "mtr_io.pl";
+use mtr_results;
 
 my $tot_real_time= 0;
 
@@ -96,6 +97,7 @@ sub mtr_report_test_passed ($) {
   {
     $timer_str= mtr_fromfile("$::opt_vardir/log/timer");
     $tinfo->{timer}= $timer_str;
+    resfile_test_info('duration', $timer_str) if $::opt_resfile;
   }
 
   # Big warning if status already set
@@ -301,6 +303,7 @@ sub mtr_report_stats ($$;$) {
 	       time - $BASETIME, "seconds executing testcases");
   }
 
+  resfile_global("duration", time - $BASETIME) if $::opt_resfile;
 
   my $warnlog= "$::opt_vardir/log/warnings";
   if ( -f $warnlog )

mysql-test/lib/mtr_results.pm

+# -*- cperl -*-
+# Copyright (c) 2011, Oracle and/or its affiliates. All rights reserved.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; version 2 of the License.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+
+package mtr_results;
+use strict;
+use IO::Handle qw[ flush ];
+
+use base qw(Exporter);
+our @EXPORT= qw(resfile_init resfile_global resfile_new_test resfile_test_info
+                resfile_output resfile_output_file resfile_print
+                resfile_print_test resfile_to_test resfile_from_test );
+
+my %curr_result;		# Result for current test
+my $curr_output;		# Output for current test
+my $do_resfile;
+
+END {
+  close RESF if $do_resfile;
+}
+
+sub resfile_init($)
+{
+  my $fname= shift;
+  open (RESF, " > $fname") or die ("Could not open result file $fname");
+  %curr_result= ();
+  $curr_output= "";
+  $do_resfile= 1;
+}
+
+# Strings need to be quoted if they start with white space or ",
+# or if they contain newlines. Pass a reference to the string.
+# If the string is quoted, " must be escaped, thus \ also must be escaped
+
+sub quote_value($)
+{
+  my $stref= shift;
+
+  for ($$stref) {
+    return unless /^[\s"]/ or /\n/;
+    s/\\/\\\\/g;
+    s/"/\\"/g;
+    $_= '"' . $_ . '"';
+  }
+}
+
+# Output global variable setting to result file.
+
+sub resfile_global($$)
+{
+  return unless $do_resfile;
+  my ($tag, $val) = @_;
+  $val= join (' ', @$val) if ref($val) eq 'ARRAY';
+  quote_value(\$val);
+  print RESF "$tag : $val\n";
+}
+
+# Prepare to add results for new test
+
+sub resfile_new_test()
+{
+  %curr_result= ();
+  $curr_output= "";
+}
+
+# Add (or change) one variable setting for current test
+
+sub resfile_test_info($$)
+{
+  my ($tag, $val) = @_;
+  return unless $do_resfile;
+  quote_value(\$val);
+  $curr_result{$tag} = $val;
+}
+
+# Add to output value for current test.
+# Will be quoted if necessary, truncated if length over 5000.
+
+sub resfile_output($)
+{
+  return unless $do_resfile;
+
+  for (shift) {
+    my $len= length;
+    if ($len > 5000) {
+      my $trlen= $len - 5000;
+      $_= substr($_, 0, 5000) . "\n[TRUNCATED $trlen chars removed]\n";
+    }
+    s/\\/\\\\/g;
+    s/"/\\"/g;
+    $curr_output .= $_;
+  }
+}
+
+# Add to output, read from named file
+
+sub resfile_output_file($)
+{
+  resfile_output(::mtr_grab_file(shift)) if $do_resfile;
+}
+
+# Print text, and also append to current output if we're collecting results
+
+sub resfile_print($)
+{
+  my $txt= shift;
+  print($txt);
+  resfile_output($txt) if $do_resfile;
+}
+
+# Print results for current test, then reset
+# (So calling a second time without having generated new results
+#  will have no effect)
+
+sub resfile_print_test()
+{
+  return unless %curr_result;
+
+  print RESF "{\n";
+  while (my ($t, $v) = each %curr_result) {
+    print RESF "$t : $v\n";
+  }
+  if ($curr_output) {
+    chomp($curr_output);
+    print RESF "  output : " . $curr_output . "\"\n";
+  }
+  print RESF "}\n";
+  IO::Handle::flush(\*RESF);
+  resfile_new_test();
+}
+
+# Add current test results to test object (to send from worker)
+
+sub resfile_to_test($)
+{
+  return unless $do_resfile;
+  my $tinfo= shift;
+  my @res_array= %curr_result;
+  $tinfo->{'resfile'}= \@res_array;
+  $tinfo->{'output'}= $curr_output if $curr_output;
+}
+
+# Get test results (from worker) from test object
+
+sub resfile_from_test($)
+{
+  return unless $do_resfile;
+  my $tinfo= shift;
+  my $res_array= $tinfo->{'resfile'};
+  return unless $res_array;
+  %curr_result= @$res_array;
+  $curr_output= $tinfo->{'output'} if defined $tinfo->{'output'};
+}
+
+1;

mysql-test/mysql-test-run.pl

@@ -96,6 +96,7 @@ use mtr_cases;
 use mtr_report;
 use mtr_match;
 use mtr_unique;
+use mtr_results;
 use IO::Socket::INET;
 use IO::Select;
 
@@ -245,6 +246,8 @@ my $build_thread= 0;
 my $opt_record;
 my $opt_report_features;
 
+our $opt_resfile= $ENV{'MTR_RESULT_FILE'} || 0;
+
 my $opt_skip_core;
 
 our $opt_check_testcases= 1;
@@ -322,6 +325,14 @@ my $opt_parallel= $ENV{MTR_PARALLEL} || 1;
 select(STDOUT);
 $| = 1; # Automatically flush STDOUT
 
+# Used by --result-file for for formatting times
+
+sub isotime($) {
+  my ($sec,$min,$hr,$day,$mon,$yr)= gmtime($_[0]);
+  return sprintf "%d-%02d-%02dT%02d:%02d:%02dZ",
+    $yr+1900, $mon+1, $day, $hr, $min, $sec;
+}
+
 main();
 
 
@@ -426,6 +437,11 @@ sub main {
   my $server_port = $server->sockport();
   mtr_report("Using server port $server_port");
 
+  if ($opt_resfile) {
+    resfile_init("$opt_vardir/mtr-results.txt");
+    print_global_resfile();
+  }
+
   # --------------------------------------------------------------------------
   # Read definitions from include/plugin.defs
   #
@@ -649,6 +665,7 @@ sub run_test_server ($$$) {
 		     $savedir);
 	      }
 	    }
+	    resfile_print_test();
 	    $num_saved_datadir++;
 	    $num_failed_test++ unless ($result->{retries} ||
                                        $result->{exp_fail});
@@ -671,6 +688,7 @@ sub run_test_server ($$$) {
 	    }
 	  }
 
+	  resfile_print_test();
 	  # Retry test run after test failure
 	  my $retries= $result->{retries} || 2;
 	  my $test_has_failed= $result->{failures} || 0;
@@ -958,6 +976,49 @@ sub set_vardir {
 }
 
 
+sub print_global_resfile {
+  resfile_global("start_time", isotime $^T);
+  resfile_global("user_id", $<);
+  resfile_global("embedded-server", $opt_embedded_server ? 1 : 0);
+  resfile_global("ps-protocol", $opt_ps_protocol ? 1 : 0);
+  resfile_global("sp-protocol", $opt_sp_protocol ? 1 : 0);
+  resfile_global("view-protocol", $opt_view_protocol ? 1 : 0);
+  resfile_global("cursor-protocol", $opt_cursor_protocol ? 1 : 0);
+  resfile_global("ssl", $opt_ssl ? 1 : 0);
+  resfile_global("compress", $opt_compress ? 1 : 0);
+  resfile_global("parallel", $opt_parallel);
+  resfile_global("check-testcases", $opt_check_testcases ? 1 : 0);
+  resfile_global("mysqld", \@opt_extra_mysqld_opt);
+  resfile_global("debug", $opt_debug ? 1 : 0);
+  resfile_global("gcov", $opt_gcov ? 1 : 0);
+  resfile_global("gprof", $opt_gprof ? 1 : 0);
+  resfile_global("valgrind", $opt_valgrind ? 1 : 0);
+  resfile_global("callgrind", $opt_callgrind ? 1 : 0);
+  resfile_global("mem", $opt_mem ? 1 : 0);
+  resfile_global("tmpdir", $opt_tmpdir);
+  resfile_global("vardir", $opt_vardir);
+  resfile_global("fast", $opt_fast ? 1 : 0);
+  resfile_global("force-restart", $opt_force_restart ? 1 : 0);
+  resfile_global("reorder", $opt_reorder ? 1 : 0);
+  resfile_global("sleep", $opt_sleep);
+  resfile_global("repeat", $opt_repeat);
+  resfile_global("user", $opt_user);
+  resfile_global("testcase-timeout", $opt_testcase_timeout);
+  resfile_global("suite-timeout", $opt_suite_timeout);
+  resfile_global("shutdown-timeout", $opt_shutdown_timeout ? 1 : 0);
+  resfile_global("warnings", $opt_warnings ? 1 : 0);
+  resfile_global("max-connections", $opt_max_connections);
+#  resfile_global("default-myisam", $opt_default_myisam ? 1 : 0);
+  resfile_global("product", "MySQL");
+  # Somewhat hacky code to convert numeric version back to dot notation
+  my $v1= int($mysql_version_id / 10000);
+  my $v2= int(($mysql_version_id % 10000)/100);
+  my $v3= $mysql_version_id % 100;
+  resfile_global("version", "$v1.$v2.$v3");
+}
+
+
+
 sub command_line_setup {
   my $opt_comment;
   my $opt_usage;
@@ -1100,6 +1161,7 @@ sub command_line_setup {
 	     'max-connections=i'        => \$opt_max_connections,
 	     'default-myisam!'          => \&collect_option,
 	     'report-times'             => \$opt_report_times,
+	     'result-file'              => \$opt_resfile,
 	     'unit-tests!'              => \$opt_ctest,
 
              'help|h'                   => \$opt_usage,
@@ -3650,6 +3712,18 @@ sub timezone {
 # Storage for changed environment variables
 my %old_env;
 
+sub resfile_report_test ($) {
+  my $tinfo=  shift;
+
+  resfile_new_test();
+
+  resfile_test_info("name", $tinfo->{name});
+  resfile_test_info("variation", $tinfo->{combination})
+    if $tinfo->{combination};
+  resfile_test_info("start_time", isotime time);
+}
+
+
 #
 # Run a single test case
 #
@@ -3662,6 +3736,7 @@ sub run_testcase ($) {
   my $tinfo=  shift;
 
   mtr_verbose("Running test:", $tinfo->{name});
+  resfile_report_test($tinfo) if $opt_resfile;
 
   # Allow only alpanumerics pluss _ - + . in combination names,
   # or anything beginning with -- (the latter comes from --combination)
@@ -3867,6 +3942,7 @@ sub run_testcase ($) {
 	# Test case suceeded, but it has produced unexpected
 	# warnings, continue in $res == 1
 	$res= 1;
+	resfile_output($tinfo->{'warnings'}) if $opt_resfile;
       }
 
       if ( $res == 0 )
@@ -3883,6 +3959,7 @@ sub run_testcase ($) {
 	    # Test case had sideeffects, not fatal error, just continue
 	    stop_all_servers($opt_shutdown_timeout);
 	    mtr_report("Resuming tests...\n");
+	    resfile_output($tinfo->{'check'}) if $opt_resfile;
 	  }
 	  else {
 	    # Test case check failed fatally, probably a server crashed
@@ -3944,6 +4021,9 @@ sub run_testcase ($) {
       # Save info from this testcase run to mysqltest.log
       if( -f $path_current_testlog)
       {
+	if ($opt_resfile && $res && $res != 62) {
+	  resfile_output_file($path_current_testlog);
+	}
 	mtr_appendfile_to_file($path_current_testlog, $path_testlog);
 	unlink($path_current_testlog);
       }