WL#4189 Add full backward compatibility to mysql-test-run.pl

 - Add copy of mtr v1 and make it possible to run it using MTR_VERSION=1

mysql-test/Makefile.am

@@ -24,7 +24,25 @@ test_SCRIPTS =	mtr \
 		mysql-test-run.pl \
 		mysql-stress-test.pl
 
-nobase_test_DATA = lib/mtr_cases.pm \
+nobase_test_DATA = \
+	lib/v1/mysql-test-run.pl \
+	lib/v1/mtr_cases.pl \
+	lib/v1/mtr_io.pl \
+	lib/v1/mtr_report.pl \
+	lib/v1/My/Config.pm \
+	lib/v1/mtr_gcov.pl \
+	lib/v1/mtr_match.pl \
+	lib/v1/mtr_stress.pl \
+	lib/v1/ndb_config_1_node.ini \
+	lib/v1/ndb_config_2_node.ini \
+	lib/v1/mtr_gprof.pl \
+	lib/v1/mtr_misc.pl \
+	lib/v1/mtr_timer.pl \
+	lib/v1/mtr_im.pl \
+	lib/v1/mtr_process.pl \
+	lib/v1/mtr_unique.pl \
+\
+	lib/mtr_cases.pm \
 	lib/mtr_gcov.pl \
 	lib/mtr_gprof.pl \
 	lib/mtr_io.pl \

mysql-test/lib/v1/My/Config.pm

+# -*- cperl -*-
+
+package My::Config::Option;
+
+use strict;
+use warnings;
+
+
+sub new {
+  my ($class, $option_name, $option_value)= @_;
+  my $self= bless { name => $option_name,
+		    value => $option_value
+		  }, $class;
+  return $self;
+}
+
+
+sub name {
+  my ($self)= @_;
+  return $self->{name};
+}
+
+
+sub value {
+  my ($self)= @_;
+  return $self->{value};
+}
+
+
+package My::Config::Group;
+
+use strict;
+use warnings;
+
+
+sub new {
+  my ($class, $group_name)= @_;
+  my $self= bless { name => $group_name,
+		    options => [],
+		    options_by_name => {},
+		  }, $class;
+  return $self;
+}
+
+
+sub insert {
+  my ($self, $option_name, $value, $if_not_exist)= @_;
+  my $option= $self->option($option_name);
+  if (defined($option) and !$if_not_exist) {
+    $option->{value}= $value;
+  }
+  else {
+    my $option= My::Config::Option->new($option_name, $value);
+    # Insert option in list
+    push(@{$self->{options}}, $option);
+    # Insert option in hash
+    $self->{options_by_name}->{$option_name}= $option;
+  }
+  return $option;
+}
+
+sub remove {
+  my ($self, $option_name)= @_;
+
+  # Check that option exists
+  my $option= $self->option($option_name);
+
+  return undef unless defined $option;
+
+  # Remove from the hash
+  delete($self->{options_by_name}->{$option_name}) or die;
+
+  # Remove from the array
+  @{$self->{options}}= grep { $_->name ne $option_name } @{$self->{options}};
+
+  return $option;
+}
+
+
+sub options {
+  my ($self)= @_;
+  return @{$self->{options}};
+}
+
+
+sub name {
+  my ($self)= @_;
+  return $self->{name};
+}
+
+
+#
+# Return a specific option in the group
+#
+sub option {
+  my ($self, $option_name)= @_;
+
+  return $self->{options_by_name}->{$option_name};
+}
+
+
+#
+# Return a specific value for an option in the group
+#
+sub value {
+  my ($self, $option_name)= @_;
+  my $option= $self->option($option_name);
+
+  die "No option named '$option_name' in this group"
+    if ! defined($option);
+
+  return $option->value();
+}
+
+
+package My::Config;
+
+use strict;
+use warnings;
+use IO::File;
+use File::Basename;
+
+#
+# Constructor for My::Config
+# - represents a my.cnf config file
+#
+# Array of arrays
+#
+sub new {
+  my ($class, $path)= @_;
+  my $group_name= undef;
+
+  my $self= bless { groups => [] }, $class;
+  my $F= IO::File->new($path, "<")
+    or die "Could not open '$path': $!";
+
+  while (  my $line= <$F> ) {
+    chomp($line);
+
+    # [group]
+    if ( $line =~ /\[(.*)\]/ ) {
+      # New group found
+      $group_name= $1;
+      #print "group: $group_name\n";
+
+      $self->insert($group_name, undef, undef);
+    }
+
+    # Magic #! comments
+    elsif ( $line =~ /^#\!/) {
+      my $magic= $line;
+      die "Found magic comment '$magic' outside of group"
+	unless $group_name;
+
+      #print "$magic\n";
+      $self->insert($group_name, $magic, undef);
+    }
+
+    # Comments
+    elsif ( $line =~ /^#/ || $line =~ /^;/) {
+      # Skip comment
+      next;
+    }
+
+    # Empty lines
+    elsif ( $line =~ /^$/ ) {
+      # Skip empty lines
+      next;
+    }
+
+    # !include <filename>
+    elsif ( $line =~ /^\!include\s*(.*?)\s*$/ ) {
+      my $include_file_name= dirname($path)."/".$1;
+      # Check that the file exists
+      die "The include file '$include_file_name' does not exist"
+	unless -f $include_file_name;
+
+      $self->append(My::Config->new($include_file_name));
+    }
+
+    # <option>
+    elsif ( $line =~ /^([\@\w-]+)\s*$/ ) {
+      my $option= $1;
+
+      die "Found option '$option' outside of group"
+	unless $group_name;
+
+      #print "$option\n";
+      $self->insert($group_name, $option, undef);
+    }
+
+    # <option>=<value>
+    elsif ( $line =~ /^([\@\w-]+)\s*=\s*(.*?)\s*$/ ) {
+      my $option= $1;
+      my $value= $2;
+
+      die "Found option '$option=$value' outside of group"
+	unless $group_name;
+
+      #print "$option=$value\n";
+      $self->insert($group_name, $option, $value);
+    } else {
+      die "Unexpected line '$line' found in '$path'";
+    }
+
+  }
+  undef $F;			# Close the file
+
+  return $self;
+}
+
+#
+# Insert a new group if it does not already exist
+# and add option if defined
+#
+sub insert {
+  my ($self, $group_name, $option, $value, $if_not_exist)= @_;
+  my $group;
+
+  # Create empty array for the group if it doesn't exist
+  if ( !$self->group_exists($group_name) ) {
+    $group= $self->_group_insert($group_name);
+  }
+  else {
+    $group= $self->group($group_name);
+  }
+
+  if ( defined $option ) {
+    #print "option: $option, value: $value\n";
+
+    # Add the option to the group
+    $group->insert($option, $value, $if_not_exist);
+  }
+}
+
+#
+# Remove a option, given group and option name
+#
+sub remove {
+  my ($self, $group_name, $option_name)= @_;
+  my $group= $self->group($group_name);
+
+  die "group '$group_name' does not exist"
+    unless defined($group);
+
+  $group->remove($option_name) or
+    die "option '$option_name' does not exist";
+}
+
+
+
+#
+# Check if group with given name exists in config
+#
+sub group_exists {
+  my ($self, $group_name)= @_;
+
+  foreach my $group ($self->groups()) {
+    return 1 if $group->{name} eq $group_name;
+  }
+  return 0;
+}
+
+
+#
+# Insert a new group into config
+#
+sub _group_insert {
+  my ($self, $group_name)= @_;
+  caller eq __PACKAGE__ or die;
+
+  # Check that group does not already exist
+  die "Group already exists" if $self->group_exists($group_name);
+
+  my $group= My::Config::Group->new($group_name);
+  push(@{$self->{groups}}, $group);
+  return $group;
+}
+
+
+#
+# Append a configuration to current config
+#
+sub append {
+  my ($self, $from)= @_;
+
+  foreach my $group ($from->groups()) {
+    foreach my $option ($group->options()) {
+      $self->insert($group->name(), $option->name(), $option->value());
+    }
+
+  }
+}
+
+
+#
+# Return a list with all the groups in config
+#
+sub groups {
+  my ($self)= @_;
+  return ( @{$self->{groups}} );
+}
+
+
+#
+# Return a list of all the groups in config
+# starting with the given string
+#
+sub like {
+  my ($self, $prefix)= @_;
+  return ( grep ( $_->{name} =~ /^$prefix/, $self->groups()) );
+}
+
+
+#
+# Return the first group in config
+# starting with the given string
+#
+sub first_like {
+  my ($self, $prefix)= @_;
+  return ($self->like($prefix))[0];
+}
+
+
+#
+# Return a specific group in the config
+#
+sub group {
+  my ($self, $group_name)= @_;
+
+  foreach my $group ( $self->groups() ) {
+    return $group if $group->{name} eq $group_name;
+  }
+  return undef;
+}
+
+
+#
+# Return a list of all options in a specific group in the config
+#
+sub options_in_group {
+  my ($self, $group_name)= @_;
+
+  my $group= $self->group($group_name);
+  return () unless defined $group;
+  return $group->options();
+}
+
+
+#
+# Return a value given group and option name
+#
+sub value {
+  my ($self, $group_name, $option_name)= @_;
+  my $group= $self->group($group_name);
+
+  die "group '$group_name' does not exist"
+    unless defined($group);
+
+  my $option= $group->option($option_name);
+  die "option '$option_name' does not exist"
+    unless defined($option);
+
+  return $option->value();
+}
+
+
+#
+# Check if an option exists
+#
+sub exists {
+  my ($self, $group_name, $option_name)= @_;
+  my $group= $self->group($group_name);
+
+  die "group '$group_name' does not exist"
+    unless defined($group);
+
+  my $option= $group->option($option_name);
+  return defined($option);
+}
+
+
+# Overload "to string"-operator with 'stringify'
+use overload
+    '""' => \&stringify;
+
+#
+# Return the config as a string in my.cnf file format
+#
+sub stringify {
+  my ($self)= @_;
+  my $res;
+
+  foreach my $group ($self->groups()) {
+    $res .= "[$group->{name}]\n";
+
+    foreach my $option ($group->options()) {
+      $res .= $option->name();
+      my $value= $option->value();
+      if (defined $value) {
+	$res .= "=$value";
+      }
+      $res .= "\n";
+    }
+    $res .= "\n";
+  }
+  return $res;
+}
+
+
+#
+# Save the config to named file
+#
+sub save {
+    my ($self, $path)= @_;
+    my $F= IO::File->new($path, ">")
+	or die "Could not open '$path': $!";
+    print $F $self;
+    undef $F; # Close the file
+}
+
+1;

mysql-test/lib/v1/mtr_gcov.pl

+# -*- cperl -*-
+# Copyright (C) 2004, 2006 MySQL AB
+# 
+# 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
+
+# This is a library file used by the Perl version of mysql-test-run,
+# and is part of the translation of the Bourne shell script with the
+# same name.
+
+use strict;
+
+# These are not to be prefixed with "mtr_"
+
+sub gcov_prepare ();
+sub gcov_collect ();
+
+##############################################################################
+#
+#  
+#
+##############################################################################
+
+sub gcov_prepare () {
+
+  `find $::glob_basedir -name \*.gcov \
+    -or -name \*.da | xargs rm`;
+}
+
+# Used by gcov
+our @mysqld_src_dirs=
+  (
+   "strings",
+   "mysys",
+   "include",
+   "extra",
+   "regex",
+   "isam",
+   "merge",
+   "myisam",
+   "myisammrg",
+   "heap",
+   "sql",
+  );
+
+sub gcov_collect () {
+
+  print "Collecting source coverage info...\n";
+  -f $::opt_gcov_msg and unlink($::opt_gcov_msg);
+  -f $::opt_gcov_err and unlink($::opt_gcov_err);
+  foreach my $d ( @mysqld_src_dirs )
+  {
+    chdir("$::glob_basedir/$d");
+    foreach my $f ( (glob("*.h"), glob("*.cc"), glob("*.c")) )
+    {
+      `$::opt_gcov $f 2>>$::opt_gcov_err  >>$::opt_gcov_msg`;
+    }
+    chdir($::glob_mysql_test_dir);
+  }
+  print "gcov info in $::opt_gcov_msg, errors in $::opt_gcov_err\n";
+}
+
+
+1;

mysql-test/lib/v1/mtr_gprof.pl

+# -*- cperl -*-
+# Copyright (C) 2004 MySQL AB
+# 
+# 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
+
+# This is a library file used by the Perl version of mysql-test-run,
+# and is part of the translation of the Bourne shell script with the
+# same name.
+
+use strict;
+
+# These are not to be prefixed with "mtr_"
+
+sub gprof_prepare ();
+sub gprof_collect ();
+
+##############################################################################
+#
+#  
+#
+##############################################################################
+
+sub gprof_prepare () {
+
+  rmtree($::opt_gprof_dir);
+  mkdir($::opt_gprof_dir);
+}
+
+# FIXME what about master1 and slave1?!
+sub gprof_collect () {
+
+  if ( -f "$::master->[0]->{'path_myddir'}/gmon.out" )
+  {
+    # FIXME check result code?!
+    mtr_run("gprof",
+            [$::exe_master_mysqld,
+             "$::master->[0]->{'path_myddir'}/gmon.out"],
+            $::opt_gprof_master, "", "", "");
+    print "Master execution profile has been saved in $::opt_gprof_master\n";
+  }
+  if ( -f "$::slave->[0]->{'path_myddir'}/gmon.out" )
+  {
+    # FIXME check result code?!
+    mtr_run("gprof",
+            [$::exe_slave_mysqld,
+             "$::slave->[0]->{'path_myddir'}/gmon.out"],
+            $::opt_gprof_slave, "", "", "");
+    print "Slave execution profile has been saved in $::opt_gprof_slave\n";
+  }
+}
+
+
+1;

mysql-test/lib/v1/mtr_io.pl

+# -*- cperl -*-
+# Copyright (C) 2004-2006 MySQL AB
+# 
+# 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
+
+# This is a library file used by the Perl version of mysql-test-run,
+# and is part of the translation of the Bourne shell script with the
+# same name.
+
+use strict;
+
+sub mtr_get_pid_from_file ($);
+sub mtr_get_opts_from_file ($);
+sub mtr_fromfile ($);
+sub mtr_tofile ($@);
+sub mtr_tonewfile($@);
+sub mtr_lastlinefromfile($);
+sub mtr_appendfile_to_file ($$);
+sub mtr_grab_file($);
+
+
+##############################################################################
+#
+#  
+#
+##############################################################################
+
+sub mtr_get_pid_from_file ($) {
+  my $pid_file_path=  shift;
+  my $TOTAL_ATTEMPTS= 30;
+  my $timeout= 1;
+
+  # We should read from the file until we get correct pid. As it is
+  # stated in BUG#21884, pid file can be empty at some moment. So, we should
+  # read it until we get valid data.
+
+  for (my $cur_attempt= 1; $cur_attempt <= $TOTAL_ATTEMPTS; ++$cur_attempt)
+  {
+    mtr_debug("Reading pid file '$pid_file_path' " .
+              "($cur_attempt of $TOTAL_ATTEMPTS)...");
+
+    open(FILE, '<', $pid_file_path)
+      or mtr_error("can't open file \"$pid_file_path\": $!");
+
+    # Read pid number from file
+    my $pid= <FILE>;
+    chomp $pid;
+    close FILE;
+
+    return $pid if $pid=~ /^(\d+)/;
+
+    mtr_debug("Pid file '$pid_file_path' does not yet contain pid number.\n" .
+              "Sleeping $timeout second(s) more...");
+
+    sleep($timeout);
+  }
+
+  mtr_error("Pid file '$pid_file_path' is corrupted. " .
+            "Can not retrieve PID in " .
+            ($timeout * $TOTAL_ATTEMPTS) . " seconds.");
+}
+
+sub mtr_get_opts_from_file ($) {
+  my $file=  shift;
+
+  open(FILE,"<",$file) or mtr_error("can't open file \"$file\": $!");
+  my @args;
+  while ( <FILE> )
+  {
+    chomp;
+
+    #    --set-variable=init_connect=set @a='a\\0c'
+    s/^\s+//;                           # Remove leading space
+    s/\s+$//;                           # Remove ending space
+
+    # This is strange, but we need to fill whitespace inside
+    # quotes with something, to remove later. We do this to
+    # be able to split on space. Else, we have trouble with
+    # options like 
+    #
+    #   --someopt="--insideopt1 --insideopt2"
+    #
+    # But still with this, we are not 100% sure it is right,
+    # we need a shell to do it right.
+
+#    print STDERR "\n";
+#    print STDERR "AAA: $_\n";
+
+    s/\'([^\'\"]*)\'/unspace($1,"\x0a")/ge;
+    s/\"([^\'\"]*)\"/unspace($1,"\x0b")/ge;
+    s/\'([^\'\"]*)\'/unspace($1,"\x0a")/ge;
+    s/\"([^\'\"]*)\"/unspace($1,"\x0b")/ge;
+
+#    print STDERR "BBB: $_\n";
+
+#    foreach my $arg (/(--?\w.*?)(?=\s+--?\w|$)/)
+
+    # FIXME ENV vars should be expanded!!!!
+
+    foreach my $arg (split(/[ \t]+/))
+    {
+      $arg =~ tr/\x11\x0a\x0b/ \'\"/;     # Put back real chars
+      # The outermost quotes has to go
+      $arg =~ s/^([^\'\"]*)\'(.*)\'([^\'\"]*)$/$1$2$3/
+        or $arg =~ s/^([^\'\"]*)\"(.*)\"([^\'\"]*)$/$1$2$3/;
+      $arg =~ s/\\\\/\\/g;
+
+      $arg =~ s/\$\{(\w+)\}/envsubst($1)/ge;
+      $arg =~ s/\$(\w+)/envsubst($1)/ge;
+
+#      print STDERR "ARG: $arg\n";
+      # Do not pass empty string since my_getopt is not capable to handle it.
+      if (length($arg))
+      {
+        push(@args, $arg)
+      }
+    }
+  }
+  close FILE;
+  return \@args;
+}
+
+sub envsubst {
+  my $string= shift;
+
+  if ( ! defined $ENV{$string} )
+  {
+    mtr_error("opt file referense \$$string that is unknown");
+  }
+
+  return $ENV{$string};
+}
+
+sub unspace {
+  my $string= shift;
+  my $quote=  shift;
+  $string =~ s/[ \t]/\x11/g;
+  return "$quote$string$quote";
+}
+
+# Read a whole file, stripping leading and trailing whitespace.
+sub mtr_fromfile ($) {
+  my $file=  shift;
+
+  open(FILE,"<",$file) or mtr_error("can't open file \"$file\": $!");
+  my $text= join('', <FILE>);
+  close FILE;
+  $text =~ s/^\s+//;                    # Remove starting space, incl newlines
+  $text =~ s/\s+$//;                    # Remove ending space, incl newlines
+  return $text;
+}
+
+sub mtr_lastlinefromfile ($) {
+  my $file=  shift;
+  my $text;
+
+  open(FILE,"<",$file) or mtr_error("can't open file \"$file\": $!");
+  while (my $line= <FILE>)
+  {
+    $text= $line;
+  }
+  close FILE;
+  return $text;
+}
+
+
+sub mtr_tofile ($@) {
+  my $file=  shift;
+
+  open(FILE,">>",$file) or mtr_error("can't open file \"$file\": $!");
+  print FILE join("", @_);
+  close FILE;
+}
+
+sub mtr_tonewfile ($@) {
+  my $file=  shift;
+
+  open(FILE,">",$file) or mtr_error("can't open file \"$file\": $!");
+  print FILE join("", @_);
+  close FILE;
+}
+
+sub mtr_appendfile_to_file ($$) {
+  my $from_file=  shift;
+  my $to_file=  shift;
+
+  open(TOFILE,">>",$to_file) or mtr_error("can't open file \"$to_file\": $!");
+  open(FROMFILE,"<",$from_file)
+    or mtr_error("can't open file \"$from_file\": $!");
+  print TOFILE while (<FROMFILE>);
+  close FROMFILE;
+  close TOFILE;
+}
+
+# Read a whole file verbatim.
+sub mtr_grab_file($) {
+  my $file= shift;
+  open(FILE, '<', $file)
+    or return undef;
+  local $/= undef;
+  my $data= scalar(<FILE>);
+  close FILE;
+  return $data;
+}
+
+
+1;

mysql-test/lib/v1/mtr_match.pl

+# -*- cperl -*-
+# Copyright (C) 2004-2006 MySQL AB
+# 
+# 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
+
+# This is a library file used by the Perl version of mysql-test-run,
+# and is part of the translation of the Bourne shell script with the
+# same name.
+
+use strict;
+
+sub mtr_match_prefix ($$);
+sub mtr_match_extension ($$);
+sub mtr_match_any_exact ($$);
+
+##############################################################################
+#
+#  
+#
+##############################################################################
+
+# Match a prefix and return what is after the prefix
+
+sub mtr_match_prefix ($$) {
+  my $string= shift;
+  my $prefix= shift;
+
+  if ( $string =~ /^\Q$prefix\E(.*)$/ ) # strncmp
+  {
+    return $1;
+  }
+  else
+  {
+    return undef;		# NULL
+  }
+}
+
+
+# Match extension and return the name without extension
+
+sub mtr_match_extension ($$) {
+  my $file= shift;
+  my $ext=  shift;
+
+  if ( $file =~ /^(.*)\.\Q$ext\E$/ ) # strchr+strcmp or something
+  {
+    return $1;
+  }
+  else
+  {
+    return undef;                       # NULL
+  }
+}
+
+
+# Match a substring anywere in a string
+
+sub mtr_match_substring ($$) {
+  my $string= shift;
+  my $substring= shift;
+
+  if ( $string =~ /(.*)\Q$substring\E(.*)$/ ) # strncmp
+  {
+    return $1;
+  }
+  else
+  {
+    return undef;		# NULL
+  }
+}
+
+
+sub mtr_match_any_exact ($$) {
+  my $string= shift;
+  my $mlist=  shift;
+
+  foreach my $m (@$mlist)
+  {
+    if ( $string eq $m )
+    {
+      return 1;
+    }
+  }
+  return 0;
+}
+
+1;

mysql-test/lib/v1/mtr_misc.pl

+# -*- cperl -*-
+# Copyright (C) 2004-2006 MySQL AB
+# 
+# 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
+
+# This is a library file used by the Perl version of mysql-test-run,
+# and is part of the translation of the Bourne shell script with the
+# same name.
+
+use strict;
+use File::Find;
+
+sub mtr_native_path($);
+sub mtr_init_args ($);
+sub mtr_add_arg ($$@);
+sub mtr_path_exists(@);
+sub mtr_script_exists(@);
+sub mtr_file_exists(@);
+sub mtr_exe_exists(@);
+sub mtr_exe_maybe_exists(@);
+sub mtr_copy_dir($$);
+sub mtr_rmtree($);
+sub mtr_same_opts($$);
+sub mtr_cmp_opts($$);
+
+##############################################################################
+#
+#  Misc
+#
+##############################################################################
+
+# Convert path to OS native format
+sub mtr_native_path($)
+{
+  my $path= shift;
+
+  # MySQL version before 5.0 still use cygwin, no need
+  # to convert path
+  return $path
+    if ($::mysql_version_id < 50000);
+
+  $path=~ s/\//\\/g
+    if ($::glob_win32);
+  return $path;
+}
+
+
+# FIXME move to own lib
+
+sub mtr_init_args ($) {
+  my $args = shift;
+  $$args = [];                            # Empty list
+}
+
+sub mtr_add_arg ($$@) {
+  my $args=   shift;
+  my $format= shift;
+  my @fargs = @_;
+
+  push(@$args, sprintf($format, @fargs));
+}
+
+##############################################################################
+
+#
+# NOTE! More specific paths should be given before less specific.
+# For example /client/debug should be listed before /client
+#
+sub mtr_path_exists (@) {
+  foreach my $path ( @_ )
+  {
+    return $path if -e $path;
+  }
+  if ( @_ == 1 )
+  {
+    mtr_error("Could not find $_[0]");
+  }
+  else
+  {
+    mtr_error("Could not find any of " . join(" ", @_));
+  }
+}
+
+
+#
+# NOTE! More specific paths should be given before less specific.
+# For example /client/debug should be listed before /client
+#
+sub mtr_script_exists (@) {
+  foreach my $path ( @_ )
+  {
+    if($::glob_win32)
+    {
+      return $path if -f $path;
+    }
+    else
+    {
+      return $path if -x $path;
+    }
+  }
+  if ( @_ == 1 )
+  {
+    mtr_error("Could not find $_[0]");
+  }
+  else
+  {
+    mtr_error("Could not find any of " . join(" ", @_));
+  }
+}
+
+
+#
+# NOTE! More specific paths should be given before less specific.
+# For example /client/debug should be listed before /client
+#
+sub mtr_file_exists (@) {
+  foreach my $path ( @_ )
+  {
+    return $path if -e $path;
+  }
+  return "";
+}
+
+
+#
+# NOTE! More specific paths should be given before less specific.
+# For example /client/debug should be listed before /client
+#
+sub mtr_exe_maybe_exists (@) {
+  my @path= @_;
+
+  map {$_.= ".exe"} @path if $::glob_win32;
+  map {$_.= ".nlm"} @path if $::glob_netware;
+  foreach my $path ( @path )
+  {
+    if($::glob_win32)
+    {
+      return $path if -f $path;
+    }
+    else
+    {
+      return $path if -x $path;
+    }
+  }
+  return "";
+}
+
+
+#
+# NOTE! More specific paths should be given before less specific.
+# For example /client/debug should be listed before /client
+#
+sub mtr_exe_exists (@) {
+  my @path= @_;
+  if (my $path= mtr_exe_maybe_exists(@path))
+  {
+    return $path;
+  }
+  # Could not find exe, show error
+  if ( @path == 1 )
+  {
+    mtr_error("Could not find $path[0]");
+  }
+  else
+  {
+    mtr_error("Could not find any of " . join(" ", @path));
+  }
+}
+
+
+sub mtr_copy_dir($$) {
+  my $from_dir= shift;
+  my $to_dir= shift;
+
+  # mtr_verbose("Copying from $from_dir to $to_dir");
+
+  mkpath("$to_dir");
+  opendir(DIR, "$from_dir")
+    or mtr_error("Can't find $from_dir$!");
+  for(readdir(DIR)) {
+    next if "$_" eq "." or "$_" eq "..";
+    if ( -d "$from_dir/$_" )
+    {
+      mtr_copy_dir("$from_dir/$_", "$to_dir/$_");
+      next;
+    }
+    copy("$from_dir/$_", "$to_dir/$_");
+  }
+  closedir(DIR);
+
+}
+
+
+sub mtr_rmtree($) {
+  my ($dir)= @_;
+  mtr_verbose("mtr_rmtree: $dir");
+
+  # Try to use File::Path::rmtree. Recent versions
+  # handles removal of directories and files that don't
+  # have full permissions, while older versions
+  # may have a problem with that and we use our own version
+
+  eval { rmtree($dir); };
+  if ( $@ ) {
+    mtr_warning("rmtree($dir) failed, trying with File::Find...");
+
+    my $errors= 0;
+
+    # chmod
+    find( {
+	   no_chdir => 1,
+	   wanted => sub {
+	     chmod(0777, $_)
+	       or mtr_warning("couldn't chmod(0777, $_): $!") and $errors++;
+	   }
+	  },
+	  $dir
+	);
+
+    # rm
+    finddepth( {
+	   no_chdir => 1,
+	   wanted => sub {
+	     my $file= $_;
+	     # Use special underscore (_) filehandle, caches stat info
+	     if (!-l $file and -d _ ) {
+	       rmdir($file) or
+		 mtr_warning("couldn't rmdir($file): $!") and $errors++;
+	     } else {
+	       unlink($file)
+		 or mtr_warning("couldn't unlink($file): $!") and $errors++;
+	     }
+	   }
+	  },
+	  $dir
+	);
+
+    mtr_error("Failed to remove '$dir'") if $errors;
+
+    mtr_report("OK, that worked!");
+  }
+}
+
+
+sub mtr_same_opts ($$) {
+  my $l1= shift;
+  my $l2= shift;
+  return mtr_cmp_opts($l1,$l2) == 0;
+}
+
+sub mtr_cmp_opts ($$) {
+  my $l1= shift;
+  my $l2= shift;
+
+  my @l1= @$l1;
+  my @l2= @$l2;
+
+  return -1 if @l1 < @l2;
+  return  1 if @l1 > @l2;
+
+  while ( @l1 )                         # Same length
+  {
+    my $e1= shift @l1;
+    my $e2= shift @l2;
+    my $cmp= ($e1 cmp $e2);
+    return $cmp if $cmp != 0;
+  }
+
+  return 0;                             # They are the same
+}
+
+#
+# Compare two arrays and put all unequal elements into a new one
+#
+sub mtr_diff_opts ($$) {
+  my $l1= shift;
+  my $l2= shift;
+  my $f;
+  my $l= [];
+  foreach my $e1 (@$l1) 
+  {    
+    $f= undef;
+    foreach my $e2 (@$l2) 
+    {
+      $f= 1 unless ($e1 ne $e2);
+    }
+    push(@$l, $e1) unless (defined $f);
+  }
+  foreach my $e2 (@$l2) 
+  {
+    $f= undef;
+    foreach my $e1 (@$l1) 
+    {
+      $f= 1 unless ($e1 ne $e2);
+    }
+    push(@$l, $e2) unless (defined $f);
+  }
+  return $l;
+}
+
+1;

mysql-test/lib/v1/mtr_stress.pl

+# -*- cperl -*-
+# Copyright (C) 2006 MySQL AB
+# 
+# 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
+
+# This is a library file used by the Perl version of mysql-test-run,
+# and is part of the translation of the Bourne shell script with the
+# same name.
+
+use strict;
+use File::Spec;
+
+# These are not to be prefixed with "mtr_"
+
+sub run_stress_test ();
+
+##############################################################################
+#
+#  Run tests in the stress mode
+#
+##############################################################################
+
+sub run_stress_test () 
+{
+
+  my $args;
+  my $stress_suitedir;
+
+  mtr_report("Starting stress testing\n");
+
+  if ( ! $::glob_use_embedded_server )
+  {
+    if ( ! mysqld_start($::master->[0],[],[]) )
+    {
+      mtr_error("Can't start the mysqld server");
+    }
+  }
+
+  my $stress_basedir=File::Spec->catdir($::opt_vardir, "stress");
+  
+  #Clean up stress dir 
+  if ( -d $stress_basedir )
+  {
+    rmtree($stress_basedir);
+  }
+  mkpath($stress_basedir);
+ 
+  if ($::opt_stress_suite ne 'main' && $::opt_stress_suite ne 'default' )
+  {
+    $stress_suitedir=File::Spec->catdir($::glob_mysql_test_dir, "suite", 
+                                         $::opt_stress_suite);
+  }
+  else
+  {
+    $stress_suitedir=$::glob_mysql_test_dir;
+  }
+
+  if ( -d $stress_suitedir )
+  {
+    #$stress_suite_t_dir=File::Spec->catdir($stress_suitedir, "t");
+    #$stress_suite_r_dir=File::Spec->catdir($stress_suitedir, "r");    
+    #FIXME: check dirs above for existence to ensure that test suite 
+    #       contains tests and results dirs
+  }
+  else
+  {
+    mtr_error("Specified test suite $::opt_stress_suite doesn't exist");
+  }
+ 
+  if ( @::opt_cases )
+  {
+    $::opt_stress_test_file=File::Spec->catfile($stress_basedir, "stress_tests.txt");
+    open(STRESS_FILE, ">$::opt_stress_test_file");
+    print STRESS_FILE join("\n",@::opt_cases),"\n";
+    close(STRESS_FILE);
+  }
+  elsif ( $::opt_stress_test_file )
+  {
+    $::opt_stress_test_file=File::Spec->catfile($stress_suitedir, 
+                                              $::opt_stress_test_file);
+    if ( ! -f $::opt_stress_test_file )
+    {
+      mtr_error("Specified file $::opt_stress_test_file with list of tests does not exist\n",
+                "Please ensure that file exists and has proper permissions");
+    }
+  }
+  else
+  {
+    $::opt_stress_test_file=File::Spec->catfile($stress_suitedir, 
+                                              "stress_tests.txt");
+    if ( ! -f $::opt_stress_test_file )
+    {
+      mtr_error("Default file $::opt_stress_test_file with list of tests does not exist\n",
+          "Please use --stress-test-file option to specify custom one or you can\n",
+          "just specify name of test for testing as last argument in command line");
+
+    }    
+  }
+
+  if ( $::opt_stress_init_file )
+  {
+    $::opt_stress_init_file=File::Spec->catfile($stress_suitedir, 
+                                              $::opt_stress_init_file);
+    if ( ! -f $::opt_stress_init_file )
+    {
+      mtr_error("Specified file $::opt_stress_init_file with list of tests does not exist\n",
+                "Please ensure that file exists and has proper permissions");
+    }
+  }
+  else
+  {
+    $::opt_stress_init_file=File::Spec->catfile($stress_suitedir, 
+                                              "stress_init.txt");
+    if ( ! -f $::opt_stress_init_file )
+    {
+      $::opt_stress_init_file='';
+    }
+  }  
+  
+  if ( $::opt_stress_mode ne 'random' && $::opt_stress_mode ne 'seq' )
+  {
+    mtr_error("You specified wrong mode $::opt_stress_mode for stress test\n",
+              "Correct values are 'random' or 'seq'");
+  }
+
+  mtr_init_args(\$args);
+  
+  mtr_add_arg($args, "--server-socket=%s", $::master->[0]->{'path_sock'});
+  mtr_add_arg($args, "--server-user=%s", $::opt_user);
+  mtr_add_arg($args, "--server-database=%s", "test");  
+  mtr_add_arg($args, "--stress-suite-basedir=%s", $::glob_mysql_test_dir);  
+  mtr_add_arg($args, "--suite=%s", $::opt_stress_suite);
+  mtr_add_arg($args, "--stress-tests-file=%s", $::opt_stress_test_file);      
+  mtr_add_arg($args, "--stress-basedir=%s", $stress_basedir);
+  mtr_add_arg($args, "--server-logs-dir=%s", $stress_basedir);
+  mtr_add_arg($args, "--stress-mode=%s", $::opt_stress_mode);
+  mtr_add_arg($args, "--mysqltest=%s", $::exe_mysqltest);
+  mtr_add_arg($args, "--threads=%s", $::opt_stress_threads);
+  mtr_add_arg($args, "--verbose");
+  mtr_add_arg($args, "--cleanup");
+  mtr_add_arg($args, "--log-error-details");
+  mtr_add_arg($args, "--abort-on-error");
+
+  if ( $::opt_stress_init_file )
+  {
+    mtr_add_arg($args, "--stress-init-file=%s", $::opt_stress_init_file);
+  }
+
+  if ( !$::opt_stress_loop_count && !$::opt_stress_test_count &&
+       !$::opt_stress_test_duration )
+  {
+    #Limit stress testing with 20 loops in case when any limit parameter 
+    #was specified 
+    $::opt_stress_test_count=20;
+  }
+
+  if ( $::opt_stress_loop_count )
+  {
+    mtr_add_arg($args, "--loop-count=%s", $::opt_stress_loop_count);
+  }
+
+  if ( $::opt_stress_test_count )
+  {
+    mtr_add_arg($args, "--test-count=%s", $::opt_stress_test_count);
+  }
+
+  if ( $::opt_stress_test_duration )
+  {
+    mtr_add_arg($args, "--test-duration=%s", $::opt_stress_test_duration);
+  }
+
+  #Run stress test
+  mtr_run("$::glob_mysql_test_dir/mysql-stress-test.pl", $args, "", "", "", "");
+  if ( ! $::glob_use_embedded_server )
+  {
+    stop_all_servers();
+  }
+}
+
+1;

mysql-test/lib/v1/ndb_config_1_node.ini

+[ndbd default]
+NoOfReplicas= 1
+MaxNoOfConcurrentTransactions= 64
+MaxNoOfConcurrentOperations= CHOOSE_MaxNoOfConcurrentOperations
+DataMemory= CHOOSE_DataMemory
+IndexMemory= CHOOSE_IndexMemory
+Diskless= CHOOSE_Diskless
+TimeBetweenWatchDogCheck= 30000
+DataDir= CHOOSE_FILESYSTEM
+MaxNoOfOrderedIndexes= CHOOSE_MaxNoOfOrderedIndexes
+MaxNoOfAttributes= CHOOSE_MaxNoOfAttributes
+TimeBetweenGlobalCheckpoints= 500
+NoOfFragmentLogFiles= 8
+FragmentLogFileSize= 6M
+DiskPageBufferMemory= CHOOSE_DiskPageBufferMemory 
+
+#
+# Increase timeouts to cater for slow test-machines
+#   (possibly running several tests in parallell)
+#
+HeartbeatIntervalDbDb= 30000
+HeartbeatIntervalDbApi= 30000
+#TransactionDeadlockDetectionTimeout= 7500
+
+[ndbd]
+HostName= CHOOSE_HOSTNAME_1   # hostname is a valid network adress
+
+[ndb_mgmd]
+HostName= CHOOSE_HOSTNAME_1   # hostname is a valid network adress
+DataDir= CHOOSE_FILESYSTEM    #
+PortNumber= CHOOSE_PORT_MGM
+
+[mysqld]
+
+[mysqld]
+
+[mysqld]
+
+[mysqld]
+
+[mysqld]
+
+[mysqld]
+
+[mysqld]
+
+[mysqld]

mysql-test/lib/v1/ndb_config_2_node.ini

+[ndbd default]
+NoOfReplicas= 2
+MaxNoOfConcurrentTransactions= 64
+MaxNoOfConcurrentOperations= CHOOSE_MaxNoOfConcurrentOperations
+DataMemory= CHOOSE_DataMemory
+IndexMemory= CHOOSE_IndexMemory
+Diskless= CHOOSE_Diskless
+TimeBetweenWatchDogCheck= 30000
+DataDir= CHOOSE_FILESYSTEM
+MaxNoOfOrderedIndexes= CHOOSE_MaxNoOfOrderedIndexes
+MaxNoOfAttributes= CHOOSE_MaxNoOfAttributes
+TimeBetweenGlobalCheckpoints= 500
+NoOfFragmentLogFiles= 4
+FragmentLogFileSize=12M
+DiskPageBufferMemory= CHOOSE_DiskPageBufferMemory
+# O_DIRECT has issues on 2.4 whach have not been handled, Bug #29612
+#ODirect= 1
+# the following parametes just function as a small regression
+# test that the parameter exists
+InitialNoOfOpenFiles= 27
+
+#
+# Increase timeouts to cater for slow test-machines
+#   (possibly running several tests in parallell)
+#
+HeartbeatIntervalDbDb= 30000
+HeartbeatIntervalDbApi= 30000
+#TransactionDeadlockDetectionTimeout= 7500
+
+[ndbd]
+HostName= CHOOSE_HOSTNAME_1   # hostname is a valid network adress
+
+[ndbd]
+HostName= CHOOSE_HOSTNAME_2   # hostname is a valid network adress
+
+[ndb_mgmd]
+HostName= CHOOSE_HOSTNAME_1   # hostname is a valid network adress
+DataDir= CHOOSE_FILESYSTEM    #
+PortNumber= CHOOSE_PORT_MGM
+
+[mysqld]
+
+[mysqld]
+
+[mysqld]
+
+[mysqld]
+
+[mysqld]
+
+[mysqld]
+
+[mysqld]
+
+[mysqld]