Add support for running in parallel

parent ea839ba0
......@@ -61,6 +61,9 @@ sub _split_option {
elsif ($option=~ /^--(.*)$/){
return ($1, undef)
}
elsif ($option=~ /^\$(.*)$/){ # $VAR
return ($1, undef)
}
elsif ($option=~ /^(.*)=(.*)$/){
return ($1, $2)
}
......
......@@ -65,7 +65,7 @@ END {
# Kill any children still running
for my $proc (values %running){
if ( $proc->is_child($$) ){
print "Killing: $proc\n";
#print "Killing: $proc\n";
$proc->kill();
}
}
......@@ -461,8 +461,8 @@ sub wait_one {
return 1;
}
warn "wait_one: expected pid $pid but got $retpid"
unless( $retpid == $pid );
#warn "wait_one: expected pid $pid but got $retpid"
# unless( $retpid == $pid );
$self->_collect();
return 0;
......
# -*- cperl -*-
#
# One test
#
package My::Test;
use strict;
use warnings;
use Carp;
sub new {
my $class= shift;
my $self= bless {
@_,
}, $class;
return $self;
}
#
# Return a unique key that can be used to
# identify this test in a hash
#
sub key {
my ($self)= @_;
my $key= $self->{name};
$key.= "+".$self->{combination} if $self->{combination};
return $key;
}
sub _encode {
my ($value)= @_;
$value =~ s/([|\\\x{0a}\x{0d}])/sprintf('\%02X', ord($1))/eg;
return $value;
}
sub _decode {
my ($value)= @_;
$value =~ s/\\([0-9a-fA-F]{2})/chr(hex($1))/ge;
return $value;
}
sub is_failed {
my ($self)= @_;
my $result= $self->{result};
croak "'is_failed' can't be called until test has been run!"
unless defined $result;
return ($result eq 'MTR_RES_FAILED');
}
sub write_test {
my ($test, $sock, $header)= @_;
print $sock $header, "\n";
while ((my ($key, $value)) = each(%$test)) {
print $sock $key, "= ";
if (ref $value eq "ARRAY") {
print $sock "[", _encode(join(", ", @$value)), "]";
} else {
print $sock _encode($value);
}
print $sock "\n";
}
print $sock "\n";
}
sub read_test {
my ($sock)= @_;
my $test= My::Test->new();
# Read the : separated key value pairs until a
# single newline on it's own line
my $line;
while (defined($line= <$sock>)) {
# List is terminated by newline on it's own
if ($line eq "\n") {
# Correctly terminated reply
# print "Got newline\n";
last;
}
chomp($line);
# Split key/value on the first "="
my ($key, $value)= split("= ", $line, 2);
if ($value =~ /^\[(.*)\]/){
my @values= split(", ", _decode($1));
push(@{$test->{$key}}, @values);
}
else
{
$test->{$key}= _decode($value);
}
}
return $test;
}
sub print_test {
my ($self)= @_;
print "[", $self->{name}, "]", "\n";
while ((my ($key, $value)) = each(%$self)) {
print " ", $key, "= ";
if (ref $value eq "ARRAY") {
print "[", join(", ", @$value), "]";
} else {
print $value;
}
print "\n";
}
print "\n";
}
1;
......@@ -40,7 +40,7 @@ our $default_storage_engine;
our $opt_with_ndbcluster_only;
our $defaults_file;
our $defaults_extra_file;
our $reorder;
our $reorder= 1;
sub collect_option {
my ($opt, $value)= @_;
......@@ -55,6 +55,7 @@ use File::Basename;
use IO::File();
use My::Config;
use My::Platform;
use My::Test;
use My::Find;
require "mtr_misc.pl";
......@@ -135,52 +136,16 @@ sub collect_test_cases ($$) {
{
my @criteria = ();
# Look for tests that must be run in a defined order - that is
# defined by test having the same name except for the ending digit
#
# Append the criteria for sorting, in order of importance.
#
push(@criteria, "ndb=" . ($tinfo->{'ndb_test'} ? "A" : "B"));
# Group test with equal options together.
# Ending with "~" makes empty sort later than filled
my $opts= $tinfo->{'master_opt'} ? $tinfo->{'master_opt'} : [];
push(@criteria, join("!", sort @{$opts}) . "~");
# Put variables into hash
my $test_name= $tinfo->{'name'};
my $depend_on_test_name;
if ( $test_name =~ /^([\D]+)([0-9]{1})$/ )
{
my $base_name= $1;
my $idx= $2;
mtr_verbose("$test_name => $base_name idx=$idx");
if ( $idx > 1 )
{
$idx-= 1;
$base_name= "$base_name$idx";
mtr_verbose("New basename $base_name");
}
foreach my $tinfo2 (@$cases)
{
if ( $tinfo2->{'name'} eq $base_name )
{
mtr_verbose("found dependent test $tinfo2->{'name'}");
$depend_on_test_name=$base_name;
}
}
}
if ( defined $depend_on_test_name )
{
mtr_verbose("Giving $test_name same critera as $depend_on_test_name");
$sort_criteria{$test_name} = $sort_criteria{$depend_on_test_name};
}
else
{
#
# Append the criteria for sorting, in order of importance.
#
push(@criteria, "ndb=" . ($tinfo->{'ndb_test'} ? "1" : "0"));
# Group test with equal options together.
# Ending with "~" makes empty sort later than filled
my $opts= $tinfo->{'master_opt'} ? $tinfo->{'master_opt'} : [];
push(@criteria, join("!", sort @{$opts}) . "~");
$sort_criteria{$test_name} = join(" ", @criteria);
}
$sort_criteria{$tinfo->{name}} = join(" ", @criteria);
}
@$cases = sort {
......@@ -454,7 +419,7 @@ sub collect_one_suite($)
}
# Copy test options
my $new_test= {};
my $new_test= My::Test->new();
while (my ($key, $value) = each(%$test)) {
if (ref $value eq "ARRAY") {
push(@{$new_test->{$key}}, @$value);
......@@ -682,13 +647,16 @@ sub collect_one_test_case {
# ----------------------------------------------------------------------
# Set defaults
# ----------------------------------------------------------------------
my $tinfo= {};
$tinfo->{'name'}= $suitename . ".$tname";
$tinfo->{'path'}= "$testdir/$filename";
my $tinfo= My::Test->new
(
name => "$suitename.$tname",
path => "$testdir/$filename",
# TODO allow nonexistsing result file
# in that case .test must issue "exit" otherwise test should fail by default
$tinfo->{'result_file'}= "$resdir/$tname.result";
# TODO allow nonexistsing result file
# in that case .test must issue "exit" otherwise test
# should fail by default
result_file => "$resdir/$tname.result",
);
# ----------------------------------------------------------------------
# Skip some tests but include in list, just mark them as skipped
......@@ -1034,19 +1002,6 @@ sub unspace {
}
sub envsubst {
my $string= shift;
if ( ! defined $ENV{$string} )
{
mtr_error(".opt file references '$string' which is not set");
}
return $ENV{$string};
}
sub opts_from_file ($) {
my $file= shift;
......@@ -1083,10 +1038,6 @@ sub opts_from_file ($) {
or $arg =~ s/^([^\'\"]*)\"(.*)\"([^\'\"]*)$/$1$2$3/;
$arg =~ s/\\\\/\\/g;
# Expand environment variables
$arg =~ s/\$\{(\w+)\}/envsubst($1)/ge;
$arg =~ s/\$(\w+)/envsubst($1)/ge;
# Do not pass empty string since my_getopt is not capable to handle it.
if (length($arg)) {
push(@args, $arg);
......@@ -1102,17 +1053,7 @@ sub print_testcases {
print "=" x 60, "\n";
foreach my $test (@cases){
print "[", $test->{name}, "]", "\n";
while ((my ($key, $value)) = each(%$test)) {
print " ", $key, "= ";
if (ref $value eq "ARRAY") {
print "[", join(", ", @$value), "]";
} else {
print $value;
}
print "\n";
}
print "\n";
$test->print_test();
}
print "=" x 60, "\n";
}
......
......@@ -27,7 +27,7 @@ our @EXPORT= qw(report_option mtr_print_line mtr_print_thick_line
mtr_warning mtr_error mtr_debug mtr_verbose
mtr_verbose_restart mtr_report_test_passed
mtr_report_test_failed mtr_report_test_skipped
mtr_report_stats);
mtr_report_stats mtr_report_test);
use mtr_match;
require "mtr_io.pl";
......@@ -35,6 +35,10 @@ require "mtr_io.pl";
my $tot_real_time= 0;
our $timestamp= 0;
our $name;
our $verbose;
our $verbose_restart= 0;
sub report_option {
my ($opt, $value)= @_;
......@@ -43,6 +47,8 @@ sub report_option {
$opt =~ s/-/_/;
no strict 'refs';
${$opt}= $value;
#print $name, " setting $opt to ", (defined $value? $value : "undef") ,"\n";
}
sub SHOW_SUITE_NAME() { return 1; };
......@@ -51,6 +57,8 @@ sub _mtr_report_test_name ($) {
my $tinfo= shift;
my $tname= $tinfo->{name};
return unless defined $verbose;
# Remove suite part of name
$tname =~ s/.*\.// unless SHOW_SUITE_NAME;
......@@ -58,7 +66,7 @@ sub _mtr_report_test_name ($) {
$tname.= " '$tinfo->{combination}'"
if defined $tinfo->{combination};
print _timestamp();
print $name, _timestamp();
printf "%-30s ", $tname;
}
......@@ -100,12 +108,19 @@ sub mtr_report_test_passed ($$) {
$timer= mtr_fromfile("$::opt_vardir/log/timer");
$tot_real_time += ($timer/1000);
$timer= sprintf "%12s", $timer;
$tinfo->{timer}= $timer;
}
# Set as passed unless already set
if ( not defined $tinfo->{'result'} ){
$tinfo->{'result'}= 'MTR_RES_PASSED';
}
mtr_report("[ pass ] $timer");
# Show any problems check-testcase found
if ( defined $tinfo->{'check'} )
{
mtr_report($tinfo->{'check'});
}
}
......@@ -143,9 +158,7 @@ sub mtr_report_test_failed ($$) {
{
# Test failure was detected by test tool and its report
# about what failed has been saved to file. Display the report.
print "\n";
mtr_printfile($logfile);
print "\n";
$tinfo->{logfile}= mtr_fromfile($logfile);
}
else
{
......@@ -156,6 +169,83 @@ sub mtr_report_test_failed ($$) {
}
sub mtr_report_test ($) {
my ($tinfo)= @_;
_mtr_report_test_name($tinfo);
if ($tinfo->{'result'} eq 'MTR_RES_FAILED'){
#my $test_failures= $tinfo->{'failures'} || 0;
#$tinfo->{'failures'}= $test_failures + 1;
if ( defined $tinfo->{'warnings'} )
{
mtr_report("[ fail ] Found warnings in server log file!");
mtr_report($tinfo->{'warnings'});
return;
}
if ( defined $tinfo->{'timeout'} )
{
mtr_report("[ fail ] timeout");
return;
}
else
{
mtr_report("[ fail ]");
}
if ( $tinfo->{'comment'} )
{
# The test failure has been detected by mysql-test-run.pl
# when starting the servers or due to other error, the reason for
# failing the test is saved in "comment"
mtr_report("\nERROR: $tinfo->{'comment'}");
}
elsif ( $tinfo->{logfile} )
{
# Test failure was detected by test tool and its report
# about what failed has been saved to file. Display the report.
mtr_report("\n");
mtr_report($tinfo->{logfile}, "\n");
}
else
{
# Neither this script or the test tool has recorded info
# about why the test has failed. Should be debugged.
mtr_report("\nUnexpected termination, probably when starting mysqld");;
}
}
elsif ($tinfo->{'result'} eq 'MTR_RES_SKIPPED')
{
if ( $tinfo->{'disable'} )
{
mtr_report("[ disabled ] $tinfo->{'comment'}");
}
elsif ( $tinfo->{'comment'} )
{
if ( $tinfo->{skip_detected_by_test} )
{
mtr_report("[ skip ]. $tinfo->{'comment'}");
}
else
{
mtr_report("[ skip ] $tinfo->{'comment'}");
}
}
else
{
mtr_report("[ skip ]");
}
}
elsif ($tinfo->{'result'} eq 'MTR_RES_PASSED')
{
my $timer= $tinfo->{timer} || "";
mtr_report("[ pass ] $timer");
}
}
sub mtr_report_stats ($) {
my $tests= shift;
......@@ -342,35 +432,42 @@ sub _timestamp {
# Print message to screen
sub mtr_report (@) {
print join(" ", @_), "\n";
if (defined $verbose)
{
print join(" ", @_), "\n";
}
}
# Print warning to screen
sub mtr_warning (@) {
print STDERR _timestamp(), "mysql-test-run: WARNING: ", join(" ", @_), "\n";
print STDERR $name, _timestamp(),
"mysql-test-run: WARNING: ", join(" ", @_), "\n";
}
# Print error to screen and then exit
sub mtr_error (@) {
print STDERR _timestamp(), "mysql-test-run: *** ERROR: ", join(" ", @_), "\n";
print STDERR $name, _timestamp(),
"mysql-test-run: *** ERROR: ", join(" ", @_), "\n";
exit(1);
}
sub mtr_debug (@) {
if ( $::opt_verbose > 1 )
if ( $verbose > 2 )
{
print STDERR _timestamp(), "####: ", join(" ", @_), "\n";
print STDERR $name,
_timestamp(), "####: ", join(" ", @_), "\n";
}
}
sub mtr_verbose (@) {
if ( $::opt_verbose )
if ( $verbose )
{
print STDERR _timestamp(), "> ",join(" ", @_),"\n";
print STDERR $name, _timestamp(),
"> ",join(" ", @_),"\n";
}
}
......@@ -378,9 +475,10 @@ sub mtr_verbose (@) {
sub mtr_verbose_restart (@) {
my ($server, @args)= @_;
my $proc= $server->{proc};
if ( $::opt_verbose_restart )
if ( $verbose_restart )
{
print STDERR _timestamp(), "> Restart $proc - ",join(" ", @args),"\n";
print STDERR $name,_timestamp(),
"> Restart $proc - ",join(" ", @args),"\n";
}
}
......
This diff is collapsed.
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment