summaryrefslogtreecommitdiffstats
path: root/mysql-test/lib
diff options
context:
space:
mode:
authorDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-13 12:24:36 +0000
committerDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-13 12:24:36 +0000
commit06eaf7232e9a920468c0f8d74dcf2fe8b555501c (patch)
treee2c7b5777f728320e5b5542b6213fd3591ba51e2 /mysql-test/lib
parentInitial commit. (diff)
downloadmariadb-06eaf7232e9a920468c0f8d74dcf2fe8b555501c.tar.xz
mariadb-06eaf7232e9a920468c0f8d74dcf2fe8b555501c.zip
Adding upstream version 1:10.11.6.upstream/1%10.11.6
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'mysql-test/lib')
-rw-r--r--mysql-test/lib/My/Config.pm544
-rw-r--r--mysql-test/lib/My/ConfigFactory.pm483
-rw-r--r--mysql-test/lib/My/CoreDump.pm516
-rw-r--r--mysql-test/lib/My/Debugger.pm287
-rw-r--r--mysql-test/lib/My/File/Path.pm225
-rw-r--r--mysql-test/lib/My/Find.pm246
-rw-r--r--mysql-test/lib/My/Handles.pm71
-rw-r--r--mysql-test/lib/My/Options.pm179
-rw-r--r--mysql-test/lib/My/Platform.pm299
-rw-r--r--mysql-test/lib/My/SafeProcess.pm640
-rw-r--r--mysql-test/lib/My/SafeProcess/Base.pm227
-rw-r--r--mysql-test/lib/My/SafeProcess/CMakeLists.txt50
-rw-r--r--mysql-test/lib/My/SafeProcess/safe_kill_win.cc146
-rw-r--r--mysql-test/lib/My/SafeProcess/safe_process.cc364
-rw-r--r--mysql-test/lib/My/SafeProcess/safe_process_win.cc389
-rw-r--r--mysql-test/lib/My/SafeProcess/wsrep_check_version.c51
-rw-r--r--mysql-test/lib/My/Suite.pm27
-rw-r--r--mysql-test/lib/My/SysInfo.pm206
-rw-r--r--mysql-test/lib/My/Tee.pm25
-rw-r--r--mysql-test/lib/My/Test.pm120
-rwxr-xr-xmysql-test/lib/generate-ssl-certs.sh66
-rw-r--r--mysql-test/lib/mtr_cases.pm1191
-rw-r--r--mysql-test/lib/mtr_gprof.pl41
-rw-r--r--mysql-test/lib/mtr_io.pl112
-rw-r--r--mysql-test/lib/mtr_match.pm98
-rw-r--r--mysql-test/lib/mtr_misc.pl361
-rw-r--r--mysql-test/lib/mtr_process.pl154
-rw-r--r--mysql-test/lib/mtr_report.pm773
-rw-r--r--mysql-test/lib/mtr_results.pm167
-rw-r--r--mysql-test/lib/mtr_stress.pl198
-rw-r--r--mysql-test/lib/mtr_unique.pm130
-rw-r--r--mysql-test/lib/openssl.cnf12
-rwxr-xr-xmysql-test/lib/process-purecov-annotations.pl63
-rw-r--r--mysql-test/lib/t/Base.t44
-rw-r--r--mysql-test/lib/t/Find.t50
-rw-r--r--mysql-test/lib/t/Options.t130
-rw-r--r--mysql-test/lib/t/Platform.t35
-rw-r--r--mysql-test/lib/t/SafeProcess.t118
-rwxr-xr-xmysql-test/lib/t/SafeProcessStress.pl165
-rw-r--r--mysql-test/lib/t/copytree.t50
-rw-r--r--mysql-test/lib/t/dummyd.pl54
-rw-r--r--mysql-test/lib/t/rmtree.t68
-rwxr-xr-xmysql-test/lib/t/testMyConfig.t147
-rwxr-xr-xmysql-test/lib/t/testMyConfigFactory.t114
-rwxr-xr-xmysql-test/lib/t/test_child.pl37
-rw-r--r--mysql-test/lib/v1/My/Config.pm438
-rw-r--r--mysql-test/lib/v1/incompatible.tests6
-rw-r--r--mysql-test/lib/v1/mtr_cases.pl939
-rw-r--r--mysql-test/lib/v1/mtr_gcov.pl75
-rw-r--r--mysql-test/lib/v1/mtr_gprof.pl65
-rw-r--r--mysql-test/lib/v1/mtr_im.pl776
-rw-r--r--mysql-test/lib/v1/mtr_io.pl218
-rw-r--r--mysql-test/lib/v1/mtr_match.pl99
-rw-r--r--mysql-test/lib/v1/mtr_misc.pl311
-rw-r--r--mysql-test/lib/v1/mtr_process.pl1022
-rw-r--r--mysql-test/lib/v1/mtr_report.pl589
-rw-r--r--mysql-test/lib/v1/mtr_stress.pl192
-rw-r--r--mysql-test/lib/v1/mtr_timer.pl159
-rw-r--r--mysql-test/lib/v1/mtr_unique.pl179
-rwxr-xr-xmysql-test/lib/v1/mysql-test-run.pl4324
60 files changed, 18865 insertions, 0 deletions
diff --git a/mysql-test/lib/My/Config.pm b/mysql-test/lib/My/Config.pm
new file mode 100644
index 00000000..c88b1170
--- /dev/null
+++ b/mysql-test/lib/My/Config.pm
@@ -0,0 +1,544 @@
+# -*- cperl -*-
+
+# Copyright (c) 2007, 2010, Oracle and/or its affiliates
+#
+# 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-1335 USA
+
+package My::Config::Option;
+
+use strict;
+use warnings;
+use Carp;
+
+# Define all MariaDB options that the user should be able to specify
+# many times in the config file. Note that options must be written
+# using '-' instead of '_' here!
+
+my %multipart_options=
+ (
+ "plugin-load-add" => 1,
+ "optimizer-switch" => 1,
+);
+
+
+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};
+}
+
+sub option {
+ my ($self)= @_;
+ my $name= $self->{name};
+ my $value= $self->{value};
+
+ my $opt= $name;
+ $opt= "$name=$value" if (defined $value);
+ $opt= "--$opt" unless ($opt =~ /^--/);
+ return $opt;
+}
+
+package My::Config::Group;
+
+use strict;
+use warnings;
+use Carp;
+
+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 {
+ $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 croak;
+
+ # 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};
+}
+
+sub suffix {
+ my ($self)= @_;
+ # Everything in name from the last .
+ my @parts= split(/\./, $self->{name});
+ my $suffix= pop(@parts);
+ return ".$suffix";
+}
+
+sub after {
+ my ($self, $prefix)= @_;
+ die unless defined $prefix;
+
+ # everything after $prefix
+ my $name= $self->{name};
+ if ($name =~ /^\Q$prefix\E(.*)$/)
+ {
+ return $1;
+ }
+ die "Failed to extract the value after '$prefix' in $name";
+}
+
+
+sub split {
+ my ($self)= @_;
+ # Return an array with name parts
+ return split(/\./, $self->{name});
+}
+
+#
+# Return a specific option in the group
+#
+sub option {
+ my ($self, $option_name)= @_;
+
+ return $self->{options_by_name}->{$option_name};
+}
+
+
+#
+# Return value for an option in the group, fail if it does not exist
+#
+sub value {
+ my ($self, $option_name)= @_;
+ my $option= $self->option($option_name);
+
+ croak "No option named '$option_name' in group '$self->{name}'"
+ if ! defined($option);
+
+ return $option->value();
+}
+
+#
+# Return value for an option if it exist
+#
+sub if_exist {
+ my ($self, $option_name)= @_;
+ my $option= $self->option($option_name);
+
+ return undef if ! defined($option);
+
+ return $option->value();
+}
+
+package My::Config::Group::ENV;
+our @ISA=qw(My::Config::Group);
+
+use strict;
+use warnings;
+use Carp;
+
+sub new {
+ my ($class, $group_name)= @_;
+ bless My::Config::Group->new($group_name), $class;
+}
+
+#
+# Return value for an option in the group, fail if it does not exist
+#
+sub value {
+ my ($self, $option_name)= @_;
+ my $option= $self->option($option_name);
+
+ if (! defined($option)) {
+ my $value= $ENV{$option_name};
+ $option= My::Config::Option->new($option_name, $value);
+ }
+ return $option->value();
+}
+
+package My::Config::Group::OPT;
+our @ISA=qw(My::Config::Group);
+
+use strict;
+use warnings;
+use Carp;
+
+sub new {
+ my ($class, $group_name)= @_;
+ bless My::Config::Group->new($group_name), $class;
+}
+
+sub options {
+ my ($self)= @_;
+ ()
+}
+
+sub value {
+ my ($self, $option_name)= @_;
+ my $option= $self->option($option_name);
+
+ croak "No option named '$option_name' in group '$self->{name}'"
+ if ! defined($option);
+
+ return $option->value()->();
+}
+
+package My::Config;
+
+use strict;
+use warnings;
+use Carp;
+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 => [
+ My::Config::Group::ENV->new('ENV'),
+ My::Config::Group::OPT->new('OPT'),
+ ] }, $class;
+ my $F= IO::File->new($path, "<")
+ or croak "Could not open '$path': $!";
+
+ while ( my $line= <$F> ) {
+ chomp($line);
+ # Remove any trailing CR from Windows edited files
+ $line=~ s/\cM$//;
+
+ # [group]
+ if ( $line =~ /^\[(.*)\]/ ) {
+ # New group found
+ $group_name= $1;
+ #print "group: $group_name\n";
+
+ $self->insert($group_name, undef, undef);
+ }
+
+ # Magic #! comments
+ elsif ( $line =~ /^(#\!\S+)(?:\s*(.*?)\s*)?$/) {
+ my ($magic, $arg)= ($1, $2);
+ croak "Found magic comment '$magic' outside of group"
+ unless $group_name;
+
+ #print "$magic\n";
+ $self->insert($group_name, $magic, $arg);
+ }
+
+ # 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 relative to path of first config file
+ if (! -f $include_file_name){
+ # Try to include file relativ to current dir
+ $include_file_name= $1;
+ }
+ croak "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;
+
+ croak "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;
+
+ croak "Found option '$option=$value' outside of group"
+ unless $group_name;
+
+ #print "$option=$value\n";
+ $self->insert($group_name, $option, $value);
+ }
+
+ # Comments
+ elsif ( $line =~ /^#/ || $line =~ /^;/) {
+ # Skip comment
+ next;
+ }
+ # Correctly process Replication Filter when they are defined
+ # with connection name.
+ elsif ( $line =~ /^([\w]+.[\w]+)\s*=\s*(.*)\s*/){
+ my $option= $1;
+ my $value= $2;
+ $self->insert($group_name, $option, $value);
+ }
+ else {
+ croak "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";
+ my $tmp_option= $option;
+ $tmp_option =~ s/_/-/g;
+
+ # If the option is an option that one can specify many times, always add
+ $if_not_exist= 1 if ($multipart_options{$tmp_option});
+
+ # Add the option to the group
+ $group->insert($option, $value, $if_not_exist);
+ }
+ return $group;
+}
+
+#
+# Remove a option, given group and option name
+#
+sub remove {
+ my ($self, $group_name, $option_name)= @_;
+ my $group= $self->group($group_name);
+
+ croak "group '$group_name' does not exist"
+ unless defined($group);
+
+ $group->remove($option_name) or
+ croak "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 croak;
+
+ # Check that group does not already exist
+ croak "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 with "real" groups in config, those
+# that should be written to a my.cnf file, those that contain options.
+# Same as groups() but without auto-generated groups like ENV or OPT.
+#
+sub option_groups {
+ my ($self)= @_;
+ return ( grep { ref $_ eq 'My::Config::Group' } @{$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);
+
+ croak "group '$group_name' does not exist"
+ unless defined($group);
+
+ my $option= $group->option($option_name);
+ croak "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);
+
+ croak "group '$group_name' does not exist"
+ unless defined($group);
+
+ my $option= $group->option($option_name);
+ return defined($option);
+}
+
+1;
diff --git a/mysql-test/lib/My/ConfigFactory.pm b/mysql-test/lib/My/ConfigFactory.pm
new file mode 100644
index 00000000..5a5b6919
--- /dev/null
+++ b/mysql-test/lib/My/ConfigFactory.pm
@@ -0,0 +1,483 @@
+# -*- cperl -*-
+# Copyright (c) 2007, 2011, Oracle and/or its affiliates
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU Library 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
+# Library 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-1335 USA
+
+package My::ConfigFactory;
+
+use strict;
+use warnings;
+use Carp;
+
+use My::Config;
+use My::Find;
+use My::Platform;
+
+use File::Basename;
+
+
+#
+# Rules to run first of all
+#
+
+sub add_opt_values {
+ my ($self, $config)= @_;
+
+ # add auto-options
+ $config->insert('OPT', 'port' => sub { fix_port($self, $config) });
+ $config->insert('mysqld', "loose-skip-plugin-$_" => undef) for (@::optional_plugins);
+}
+
+my @pre_rules=
+(
+ \&add_opt_values,
+);
+
+
+my @share_locations= ("share/mariadb", "share/mysql", "sql/share", "share");
+
+
+sub get_basedir {
+ my ($self, $group)= @_;
+ my $basedir= $group->if_exist('basedir') ||
+ $self->{ARGS}->{basedir};
+ return $basedir;
+}
+
+sub get_testdir {
+ my ($self, $group)= @_;
+ my $testdir= $group->if_exist('testdir') ||
+ $self->{ARGS}->{testdir};
+ return $testdir;
+}
+
+# Retrive build directory (which is different from basedir in out-of-source build)
+sub get_bindir {
+ if (defined $ENV{MTR_BINDIR})
+ {
+ return $ENV{MTR_BINDIR};
+ }
+ my ($self, $group)= @_;
+ return $self->get_basedir($group);
+}
+
+sub fix_charset_dir {
+ my ($self, $config, $group_name, $group)= @_;
+ return my_find_dir($self->get_basedir($group),
+ \@share_locations, "charsets");
+}
+
+sub fix_language {
+ my ($self, $config, $group_name, $group)= @_;
+ return my_find_dir($self->get_bindir($group),
+ \@share_locations);
+}
+
+sub fix_datadir {
+ my ($self, $config, $group_name)= @_;
+ my $vardir= $self->{ARGS}->{vardir};
+ return "$vardir/$group_name/data";
+}
+
+sub fix_pidfile {
+ my ($self, $config, $group_name, $group)= @_;
+ my $vardir= $self->{ARGS}->{vardir};
+ return "$vardir/run/$group_name.pid";
+}
+
+sub fix_port {
+ my ($self, $config, $group_name, $group)= @_;
+ return $self->{PORT}++;
+}
+
+sub fix_host {
+ my ($self)= @_;
+ 'localhost'
+}
+
+sub is_unique {
+ my ($config, $name, $value)= @_;
+
+ foreach my $group ( $config->groups() ) {
+ if ($group->option($name)) {
+ if ($group->value($name) eq $value){
+ return 0;
+ }
+ }
+ }
+ return 1;
+}
+
+sub fix_server_id {
+ my ($self, $config, $group_name, $group)= @_;
+#define in the order that mysqlds are listed in my.cnf
+
+ my $server_id= $group->if_exist('server-id');
+ if (defined $server_id){
+ if (!is_unique($config, 'server-id', $server_id)) {
+ croak "The server-id($server_id) for '$group_name' is not unique";
+ }
+ return $server_id;
+ }
+
+ do {
+ $server_id= $self->{SERVER_ID}++;
+ } while(!is_unique($config, 'server-id', $server_id));
+
+ #print "$group_name: server_id: $server_id\n";
+ return $server_id;
+}
+
+sub fix_socket {
+ my ($self, $config, $group_name, $group)= @_;
+ # Put socket file in tmpdir
+ my $dir= $self->{ARGS}->{tmpdir};
+ return "$dir/$group_name.sock";
+}
+
+sub fix_tmpdir {
+ my ($self, $config, $group_name, $group)= @_;
+ my $dir= $self->{ARGS}->{tmpdir};
+ return "$dir/$group_name";
+}
+
+sub fix_log_error {
+ my ($self, $config, $group_name, $group)= @_;
+ my $dir= $self->{ARGS}->{vardir};
+ if ( $::opt_valgrind and $::opt_debug ) {
+ return "$dir/log/$group_name.trace";
+ } else {
+ return "$dir/log/$group_name.err";
+ }
+}
+
+sub fix_log {
+ my ($self, $config, $group_name, $group)= @_;
+ my $dir= dirname($group->value('datadir'));
+ return "$dir/mysqld.log";
+}
+
+sub fix_bind_address {
+ if (IS_WINDOWS) {
+ return "*";
+ } else {
+ return "127.0.0.1";
+ }
+}
+sub fix_log_slow_queries {
+ my ($self, $config, $group_name, $group)= @_;
+ my $dir= dirname($group->value('datadir'));
+ return "$dir/mysqld-slow.log";
+}
+
+#
+# Rules to run for each mysqld in the config
+# - will be run in order listed here
+#
+my @mysqld_rules=
+ (
+ { 'basedir' => sub { return shift->{ARGS}->{basedir}; } },
+ { 'tmpdir' => \&fix_tmpdir },
+ { 'character-sets-dir' => \&fix_charset_dir },
+ { 'lc-messages-dir' => \&fix_language },
+ { 'datadir' => \&fix_datadir },
+ { 'pid-file' => \&fix_pidfile },
+ { '#host' => \&fix_host },
+ { 'port' => \&fix_port },
+ { 'socket' => \&fix_socket },
+ { 'log-error' => \&fix_log_error },
+ { 'general-log' => 1 },
+ { 'plugin-dir' => sub { $::plugindir } },
+ { 'general-log-file' => \&fix_log },
+ { 'slow-query-log' => 1 },
+ { 'slow-query-log-file' => \&fix_log_slow_queries },
+ { '#user' => sub { return shift->{ARGS}->{user} || ""; } },
+ { '#password' => sub { return shift->{ARGS}->{password} || ""; } },
+ { 'server-id' => \&fix_server_id, },
+ { 'bind-address' => \&fix_bind_address },
+ );
+
+#
+# Rules to run for [client] section
+# - will be run in order listed here
+#
+my @client_rules=
+(
+ { 'character-sets-dir' => \&fix_charset_dir },
+ { 'plugin-dir' => sub { $::client_plugindir } },
+);
+
+
+#
+# Rules to run for [mysqltest] section
+# - will be run in order listed here
+#
+my @mysqltest_rules=
+(
+);
+
+
+#
+# Rules to run for [mysqlbinlog] section
+# - will be run in order listed here
+#
+my @mysqlbinlog_rules=
+(
+);
+
+
+#
+# Rules to run for [mysql_upgrade] section
+# - will be run in order listed here
+#
+my @mysql_upgrade_rules=
+(
+ { 'tmpdir' => sub { return shift->{ARGS}->{tmpdir}; } },
+);
+
+
+#
+# Generate a [client.<suffix>] group to be
+# used for connecting to [mysqld.<suffix>]
+#
+sub post_check_client_group {
+ my ($self, $config, $client_group_name, $mysqld_group_name)= @_;
+
+
+ # Settings needed for client, copied from its "mysqld"
+ my %client_needs=
+ (
+ port => 'port',
+ socket => 'socket',
+ host => '#host',
+ user => '#user',
+ password => '#password',
+ );
+ my $group_to_copy_from= $config->group($mysqld_group_name);
+ while (my ($name_to, $name_from)= each( %client_needs )) {
+ my $option= $group_to_copy_from->option($name_from);
+
+ if (! defined $option){
+ #print $config;
+ croak "Could not get value for '$name_from' for test $self->{testname}";
+ }
+ $config->insert($client_group_name, $name_to, $option->value())
+ }
+}
+
+
+sub post_check_client_groups {
+ my ($self, $config)= @_;
+
+ my $first_mysqld= $config->first_like('mysqld\.');
+
+ return unless $first_mysqld;
+
+ # Always generate [client] pointing to the first
+ # [mysqld.<suffix>]
+ $self->post_check_client_group($config,
+ 'client',
+ $first_mysqld->name());
+
+ # Then generate [client.<suffix>] for each [mysqld.<suffix>]
+ foreach my $mysqld ( $config->like('mysqld\.') ) {
+ $self->post_check_client_group($config,
+ 'client'.$mysqld->after('mysqld'),
+ $mysqld->name())
+ }
+
+}
+
+
+#
+# Generate [embedded] by copying the values
+# needed from the default [mysqld] section
+# and from first [mysqld.<suffix>]
+#
+sub post_check_embedded_group {
+ my ($self, $config)= @_;
+
+ return unless $self->{ARGS}->{embedded};
+
+ my $mysqld= $config->group('mysqld') or
+ croak "Can't run with embedded, config has no default mysqld section";
+
+ my $first_mysqld= $config->first_like('mysqld\.') or
+ croak "Can't run with embedded, config has no mysqld";
+
+ my %no_copy = map { $_ => 1 }
+ (
+ 'log-error', # Embedded server writes stderr to mysqltest's log file
+ 'slave-net-timeout', # Embedded server are not build with replication
+ );
+
+ foreach my $option ( $mysqld->options(), $first_mysqld->options() ) {
+ # Don't copy options whose name is in "no_copy" list
+ next if $no_copy{$option->name()};
+
+ $config->insert('embedded', $option->name(), $option->value())
+ }
+
+}
+
+
+sub resolve_at_variable {
+ my ($self, $config, $group, $option)= @_;
+ local $_ = $option->value();
+ my ($res, $after);
+
+ while (m/(.*?)\@((?:\w+\.)+)(#?[-\w]+)/g) {
+ my ($before, $group_name, $option_name)= ($1, $2, $3);
+ $after = $';
+ chop($group_name);
+
+ my $from_group= $config->group($group_name)
+ or croak "There is no group named '$group_name' that ",
+ "can be used to resolve '$option_name' for test '$self->{testname}'";
+
+ my $value= $from_group->value($option_name);
+ if (!defined($value))
+ {
+ ::mtr_verbose("group: $group_name option_name: $option_name is undefined");
+ }
+ else
+ {
+ $res .= $before.$value;
+ }
+ }
+ $res .= $after;
+
+ $option->{value}= $res;
+}
+
+
+sub post_fix_resolve_at_variables {
+ my ($self, $config)= @_;
+
+ foreach my $group ( $config->groups() ) {
+ foreach my $option ( $group->options()) {
+ next unless defined $option->value();
+
+ $self->resolve_at_variable($config, $group, $option)
+ if ($option->value() =~ /\@/);
+ }
+ }
+}
+
+#
+# Rules to run last of all
+#
+my @post_rules=
+(
+ \&post_check_client_groups,
+ \&post_fix_resolve_at_variables,
+ \&post_check_embedded_group,
+);
+
+
+sub run_rules_for_group {
+ my ($self, $config, $group, @rules)= @_;
+ foreach my $hash ( @rules ) {
+ while (my ($option, $rule)= each( %{$hash} )) {
+ # Only run this rule if the value is not already defined
+ if (!$config->exists($group->name(), $option)) {
+ my $value;
+ if (ref $rule eq "CODE") {
+ # Call the rule function
+ $value= &$rule($self, $config, $group->name(),
+ $config->group($group->name()));
+ } else {
+ $value= $rule;
+ }
+ if (defined $value) {
+ $config->insert($group->name(), $option, $value, 1);
+ }
+ }
+ }
+ }
+}
+
+
+sub run_section_rules {
+ my ($self, $config, $name, @rules)= @_;
+
+ foreach my $group ( $config->like($name) ) {
+ $self->run_rules_for_group($config, $group, @rules);
+ }
+}
+
+
+sub new_config {
+ my ($class, $args)= @_;
+
+ my @required_args= ('basedir', 'baseport', 'vardir', 'template_path');
+
+ foreach my $required ( @required_args ) {
+ croak "you must pass '$required'" unless defined $args->{$required};
+ }
+
+ # Open the config template
+ my $config= My::Config->new($args->{'template_path'});
+ my $self= bless {
+ CONFIG => $config,
+ ARGS => $args,
+ PORT => $args->{baseport},
+ SERVER_ID => 1,
+ testname => $args->{testname},
+ }, $class;
+
+ # Run pre rules
+ foreach my $rule ( @pre_rules ) {
+ &$rule($self, $config);
+ }
+
+ $self->run_section_rules($config,
+ 'mysqld\.',
+ @mysqld_rules);
+
+ # [mysqlbinlog] need additional settings
+ $self->run_rules_for_group($config,
+ $config->insert('mysqlbinlog'),
+ @mysqlbinlog_rules);
+
+ # [mysql_upgrade] need additional settings
+ $self->run_rules_for_group($config,
+ $config->insert('mysql_upgrade'),
+ @mysql_upgrade_rules);
+
+ # Additional rules required for [client]
+ $self->run_rules_for_group($config,
+ $config->insert('client'),
+ @client_rules);
+
+
+ # Additional rules required for [mysqltest]
+ $self->run_rules_for_group($config,
+ $config->insert('mysqltest'),
+ @mysqltest_rules);
+
+ {
+ # Run post rules
+ foreach my $rule ( @post_rules ) {
+ &$rule($self, $config);
+ }
+ }
+
+ return $config;
+}
+
+
+1;
+
diff --git a/mysql-test/lib/My/CoreDump.pm b/mysql-test/lib/My/CoreDump.pm
new file mode 100644
index 00000000..be6d2114
--- /dev/null
+++ b/mysql-test/lib/My/CoreDump.pm
@@ -0,0 +1,516 @@
+# -*- cperl -*-
+# Copyright (c) 2008, 2013, 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-1335 USA
+
+package My::CoreDump;
+
+use strict;
+use Carp;
+use My::Platform;
+use Text::Wrap;
+use Data::Dumper;
+
+use File::Temp qw/ tempfile tempdir /;
+use File::Find;
+use File::Basename;
+use mtr_results;
+use mtr_report;
+
+my %opts;
+my %config;
+my $help = "\n\nOptions for printing core dumps\n\n";
+
+sub register_opt($$$) {
+ my ($name, $format, $msg)= @_;
+ my @names= split(/\|/, $name);
+ my $option_name= $names[0];
+ $option_name=~ s/-/_/;
+ $opts{$name. $format}= \$config{$option_name};
+ $help.= wrap(sprintf(" %-23s", join(', ', @names)), ' 'x25, "$msg\n");
+}
+
+# To preserve order we use array instead of hash
+my @print_formats= (
+ short => {
+ description => "Failing stack trace",
+ codes => {}
+ },
+ medium => {
+ description => "All stack traces",
+ codes => {}
+ },
+ detailed => {
+ description => "All stack traces with debug context",
+ codes => {}
+ },
+ custom => {
+ description => "Custom debugger script for printing stack"
+ },
+ # 'no' must be last (check generated help)
+ no => {
+ description => "Skip stack trace printing"
+ }
+);
+
+# TODO: make class for each {method, get_code}
+my @print_methods= (IS_WINDOWS) ? (cdb => { method => \&_cdb }) : (
+ gdb => {
+ method => \&_gdb,
+ get_code => \&_gdb_format,
+ },
+ dbx => {
+ method => \&_dbx
+ },
+ lldb => {
+ method => \&_lldb
+ },
+ # 'auto' must be last (check generated help)
+ auto => {
+ method => \&_auto
+ }
+);
+
+# But we also use hash
+my %print_formats= @print_formats;
+my %print_methods= @print_methods;
+
+# and scalar
+my $x= 0;
+my $print_formats= join(', ', grep { ++$x % 2 } @print_formats);
+$x= 0;
+my $print_methods= join(', ', grep { ++$x % 2 } @print_methods);
+
+# Fill 'short' and 'detailed' formats per each print_method
+# that has interface for that
+for my $f (keys %print_formats)
+{
+ next unless exists $print_formats{$f}->{codes};
+ for my $m (keys %print_methods)
+ {
+ next unless exists $print_methods{$m}->{get_code};
+ # That calls f.ex. _gdb_format('short')
+ # and assigns { gdb => value-of-_gdb_format } into $print_formats{short}->{format}:
+ $print_formats{$f}->{codes}->{$m}= $print_methods{$m}->{get_code}->($f);
+ }
+}
+
+register_opt('print-core|C', ':s',
+ "Print core dump format: ". $print_formats. " (for not printing cores). ".
+ "Defaults to value of MTR_PRINT_CORE or 'medium'");
+if (!IS_WINDOWS)
+{
+ register_opt('print-method', '=s',
+ "Print core method: ". join(', ', $print_methods). " (try each method until success). ".
+ "Defaults to 'auto'");
+}
+
+sub options() { %opts }
+sub help() { $help }
+
+
+sub env_or_default($$) {
+ my ($default, $env)= @_;
+ if (exists $ENV{$env}) {
+ my $f= $ENV{$env};
+ $f= 'custom'
+ if $f =~ m/^custom:/;
+ return $ENV{$env}
+ if exists $print_formats{$f};
+ mtr_verbose("$env value ignored: $ENV{$env}");
+ }
+ return $default;
+}
+
+sub pre_setup() {
+ $config{print_core}= env_or_default('medium', 'MTR_PRINT_CORE')
+ if not defined $config{print_core};
+ $config{print_method}= (IS_WINDOWS) ? 'cdb' : 'auto'
+ if not defined $config{print_method};
+ # If the user has specified 'custom' we fill appropriate print_format
+ # and that will be used automatically
+ # Note: this can assign 'custom' to method 'auto'.
+ if ($config{print_core} =~ m/^custom:(.+)$/) {
+ $config{print_core}= 'custom';
+ $print_formats{'custom'}= {
+ $config{print_method} => $1
+ }
+ }
+ mtr_error "Wrong value for --print-core: $config{print_core}"
+ if not exists $print_formats{$config{print_core}};
+ mtr_error "Wrong value for --print-method: $config{print_method}"
+ if not exists $print_methods{$config{print_method}};
+
+ mtr_debug(Data::Dumper->Dump(
+ [\%config, \%print_formats, \%print_methods],
+ [qw(config print_formats print_methods)]));
+}
+
+my $hint_mysqld; # Last resort guess for executable path
+
+# If path in core file is 79 chars we assume it's been truncated
+# Looks like we can still find the full path using 'strings'
+# If that doesn't work, use the hint (mysqld path) as last resort.
+
+sub _verify_binpath {
+ my ($binary, $core_name)= @_;
+ my $binpath;
+
+ if (length $binary != 79) {
+ $binpath= $binary;
+ print "Core generated by '$binpath'\n";
+ } else {
+ # Last occurrence of path ending in /mysql*, cut from first /
+ if (`strings '$core_name' | grep "/mysql[^/. ]*\$" | tail -1` =~ /(\/.*)/) {
+ $binpath= $1;
+ print "Guessing that core was generated by '$binpath'\n";
+ } else {
+ return unless $hint_mysqld;
+ $binpath= $hint_mysqld;
+ print "Wild guess that core was generated by '$binpath'\n";
+ }
+ }
+ return $binpath;
+}
+
+
+# Returns GDB code according to specified format
+
+# Note: this is like simple hash, separate interface was made
+# in advance for implementing below TODO
+
+# TODO: _gdb_format() and _gdb() should be separate class
+# (like the other printing methods)
+
+sub _gdb_format($) {
+ my ($format)= @_;
+ my %formats= (
+ short => "bt\n",
+ medium => "thread apply all bt\n",
+ detailed =>
+ "bt\n".
+ "set print sevenbit on\n".
+ "set print static-members off\n".
+ "set print frame-arguments all\n".
+ "thread apply all bt full\n".
+ "quit\n"
+ );
+ confess "Unknown format: ". $format
+ unless exists $formats{$format};
+ return $formats{$format};
+}
+
+
+sub _gdb {
+ my ($core_name, $code)= @_;
+ confess "Undefined format"
+ unless defined $code;
+
+ # Check that gdb exists
+ `gdb --version`;
+ if ($?) {
+ print "gdb not found, cannot get the stack trace\n";
+ return;
+ }
+
+ if (-f $core_name) {
+ mtr_verbose("Trying 'gdb' to get a backtrace from coredump $core_name");
+ } else {
+ print "\nCoredump $core_name does not exist, cannot run 'gdb'\n";
+ return;
+ }
+
+ # Find out name of binary that generated core
+ `gdb -c '$core_name' --batch 2>&1` =~
+ /Core was generated by `([^\s\'\`]+)/;
+ my $binary= $1 or return;
+
+ $binary= _verify_binpath ($binary, $core_name) or return;
+
+ # Create tempfile containing gdb commands
+ my ($tmp, $tmp_name) = tempfile();
+ print $tmp $code;
+ close $tmp or die "Error closing $tmp_name: $!";
+
+ # Run gdb
+ my $gdb_output=
+ `gdb '$binary' -c '$core_name' -x '$tmp_name' --batch 2>&1`;
+
+ unlink $tmp_name or die "Error removing $tmp_name: $!";
+
+ return if $? >> 8;
+ return unless $gdb_output;
+
+ 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).
+--------------------------
+EOF
+ return 1;
+}
+
+
+sub _dbx {
+ my ($core_name, $format)= @_;
+
+ print "\nTrying 'dbx' to get a backtrace\n";
+
+ return unless -f $core_name;
+
+ # Find out name of binary that generated core
+ `echo | dbx - '$core_name' 2>&1` =~
+ /Corefile specified executable: "([^"]+)"/;
+ my $binary= $1 or return;
+
+ $binary= _verify_binpath ($binary, $core_name) or return;
+
+ # Find all threads
+ my @thr_ids = `echo threads | dbx '$binary' '$core_name' 2>&1` =~ /t@\d+/g;
+
+ # Create tempfile containing dbx commands
+ my ($tmp, $tmp_name) = tempfile();
+ foreach my $thread (@thr_ids) {
+ print $tmp "where $thread\n";
+ }
+ print $tmp "exit\n";
+ close $tmp or die "Error closing $tmp_name: $!";
+
+ # Run dbx
+ my $dbx_output=
+ `cat '$tmp_name' | dbx '$binary' '$core_name' 2>&1`;
+
+ unlink $tmp_name or die "Error removing $tmp_name: $!";
+
+ return if $? >> 8;
+ return unless $dbx_output;
+
+ 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.
+----------------------------
+EOF
+ return 1;
+}
+
+
+# Check that Debugging tools for Windows are installed
+sub cdb_check {
+ `cdb -? 2>&1`;
+ if ($? >> 8)
+ {
+ print "Cannot find the cdb debugger. Please install Debugging tools for Windows\n";
+ print "and set PATH environment variable to include location of cdb.exe";
+ }
+}
+
+
+sub _cdb {
+ my ($core_name, $format)= @_;
+ print "\nTrying 'cdb' to get a backtrace\n";
+ return unless -f $core_name;
+ # Read module list, find out the name of executable and
+ # build symbol path (required by cdb if executable was built on
+ # different machine)
+ my $tmp_name= $core_name.".cdb_lmv";
+ `cdb -z $core_name -c \"lmv;q\" > $tmp_name 2>&1`;
+ if ($? >> 8)
+ {
+ unlink($tmp_name);
+ # check if cdb is installed and complain if not
+ cdb_check();
+ return;
+ }
+
+ open(temp,"< $tmp_name");
+ my %dirhash=();
+ while(<temp>)
+ {
+ if($_ =~ /Image path\: (.*)/)
+ {
+ if (rindex($1,'\\') != -1)
+ {
+ my $dir= substr($1, 0, rindex($1,'\\'));
+ $dirhash{$dir}++;
+ }
+ }
+ }
+ close(temp);
+ unlink($tmp_name);
+
+ my $image_path= join(";", (keys %dirhash),".");
+
+ # For better callstacks, setup _NT_SYMBOL_PATH to include
+ # OS symbols. Note : Dowloading symbols for the first time
+ # can take some minutes
+ if (!$ENV{'_NT_SYMBOL_PATH'})
+ {
+ my $windir= $ENV{'windir'};
+ my $symbol_cache= substr($windir ,0, index($windir,'\\'))."\\symbols";
+
+ print "OS debug symbols will be downloaded and stored in $symbol_cache.\n";
+ print "You can control the location of symbol cache with _NT_SYMBOL_PATH\n";
+ print "environment variable. Please refer to Microsoft KB article\n";
+ print "http://support.microsoft.com/kb/311503 for details about _NT_SYMBOL_PATH\n";
+ print "-------------------------------------------------------------------------\n";
+
+ $ENV{'_NT_SYMBOL_PATH'}.=
+ "srv*".$symbol_cache."*http://msdl.microsoft.com/download/symbols";
+ }
+
+ my $symbol_path= $image_path.";".$ENV{'_NT_SYMBOL_PATH'};
+
+
+ # Run cdb. Use "analyze" extension to print crashing thread stacktrace
+ # and "uniqstack" to print other threads
+
+ my $cdb_cmd = "!sym prompts off; !analyze -v; .ecxr; !for_each_frame dv /t;!uniqstack -p;q";
+ my $cdb_output=
+ `cdb -c "$cdb_cmd" -z $core_name -i "$image_path" -y "$symbol_path" -t 0 -lines 2>&1`;
+ return if $? >> 8;
+ return unless $cdb_output;
+
+ # Remove comments (lines starting with *), stack pointer and frame
+ # pointer adresses and offsets to function to make output better readable
+ $cdb_output=~ s/^\*.*\n//gm;
+ $cdb_output=~ s/^([\:0-9a-fA-F\`]+ )+//gm;
+ $cdb_output=~ s/^ChildEBP RetAddr//gm;
+ $cdb_output=~ s/^Child\-SP RetAddr Call Site//gm;
+ $cdb_output=~ s/\+0x([0-9a-fA-F]+)//gm;
+
+ 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.
+EOF
+ return 1;
+}
+
+
+sub _lldb
+{
+ my ($core_name)= @_;
+
+ print "\nTrying 'lldb' to get a backtrace from coredump $core_name\n";
+
+ # Create tempfile containing lldb commands
+ my ($tmp, $tmp_name)= tempfile();
+ print $tmp
+ "bt\n",
+ "thread backtrace all\n",
+ "quit\n";
+ close $tmp or die "Error closing $tmp_name: $!";
+
+ my $lldb_output= `lldb -c '$core_name' -s '$tmp_name' 2>&1`;
+
+ unlink $tmp_name or die "Error removing $tmp_name: $!";
+
+ if ($? == 127)
+ {
+ print "lldb not found, cannot get the stack trace\n";
+ return;
+ }
+
+ return if $?;
+ return unless $lldb_output;
+
+ resfile_print <<EOF . $lldb_output . "\n";
+Output from lldb follows. The first stack trace is from the failing thread.
+The following stack traces are from all threads (so the failing one is
+duplicated).
+--------------------------
+EOF
+ return 1;
+}
+
+
+sub _auto
+{
+ my ($core_name, $code, $rest)= @_;
+ # We use ordered array @print_methods and omit auto itself
+ my @valid_methods= @print_methods[0 .. $#print_methods - 2];
+ my $x= 0;
+ my @methods= grep { ++$x % 2} @valid_methods;
+ my $f= $config{print_core};
+ foreach my $m (@methods)
+ {
+ my $debugger= $print_methods{$m};
+ confess "Broken @print_methods"
+ if $debugger->{method} == \&_auto;
+ # If we didn't find format for 'auto' (that is only possible for 'custom')
+ # we get format for specific debugger
+ if (not defined $code && defined $print_formats{$f} and
+ exists $print_formats{$f}->{codes}->{$m})
+ {
+ $code= $print_formats{$f}->{codes}->{$m};
+ }
+ mtr_verbose2("Trying to print with method ${m}:${f}");
+ if ($debugger->{method}->($core_name, $code)) {
+ return;
+ }
+ }
+}
+
+
+sub show {
+ my ($core_name, $exe_mysqld, $parallel)= @_;
+ if ($config{print_core} ne 'no') {
+ my $f= $config{print_core};
+ my $m= $config{print_method};
+ my $code= undef;
+ if (exists $print_formats{$f}->{codes} and
+ exists $print_formats{$f}->{codes}->{$m}) {
+ $code= $print_formats{$f}->{codes}->{$m};
+ }
+ mtr_verbose2("Printing core with method ${m}:${f}");
+ mtr_debug("code: ${code}");
+ $print_methods{$m}->{method}->($core_name, $code);
+ }
+ return;
+}
+
+
+sub core_wanted($$$$$) {
+ my ($num_saved_cores, $opt_max_save_core, $compress,
+ $exe_mysqld, $opt_parallel)= @_;
+ my $core_file= $File::Find::name;
+ my $core_name= basename($core_file);
+
+ # Name beginning with core, not ending in .gz
+ if (($core_name =~ /^core/ and $core_name !~ /\.gz$/)
+ or (IS_WINDOWS and $core_name =~ /\.dmp$/))
+ {
+ # Ending with .dmp
+ mtr_report(" - found '$core_name'",
+ "($$num_saved_cores/$opt_max_save_core)");
+
+ show($core_file, $exe_mysqld, $opt_parallel);
+
+ # Limit number of core files saved
+ if ($$num_saved_cores >= $opt_max_save_core)
+ {
+ mtr_report(" - deleting it, already saved",
+ "$opt_max_save_core");
+ unlink("$core_file");
+ }
+ else
+ {
+ main::mtr_compress_file($core_file) if $compress;
+ ++$$num_saved_cores;
+ }
+ }
+}
+
+
+1;
diff --git a/mysql-test/lib/My/Debugger.pm b/mysql-test/lib/My/Debugger.pm
new file mode 100644
index 00000000..d129aa09
--- /dev/null
+++ b/mysql-test/lib/My/Debugger.pm
@@ -0,0 +1,287 @@
+package My::Debugger;
+
+use strict;
+use warnings;
+use Text::Wrap;
+use Cwd;
+use My::Platform;
+use mtr_report;
+
+# 1. options to support:
+# --xxx[=ARGS]
+# --manual-xxx[=ARGS]
+# --client-xxx[=ARGS]
+# --boot-xxx[=ARGS]
+# TODO --manual-client-xxx[=ARGS]
+# TODO --manual-boot-xxx[=ARGS]
+# TODO --exec-xxx[=ARGS] (for $ENV{MYSQL}, etc)
+#
+# ARGS is a semicolon-separated list of commands for the
+# command file. If the first command starts from '-' it'll
+# be for a command line, not for a command file.
+#
+# 2. terminal to use: xterm
+# TODO MTR_TERM="xterm -title {title} -e {command}"
+#
+# 3. debugger combinations are *not allowed*
+# (thus no --valgrind --gdb)
+#
+# 4. variables for the command line / file templates:
+# {vardir} -> vardir
+# {exe} -> /path/to/binary/to/execute
+# {args} -> command-line arguments, "-quoted
+# {input}
+# {type} -> client, mysqld.1, etc
+# {script} -> vardir/tmp/{debugger}init.$type
+# {log} -> vardir/log/$type.{debugger}
+# {options} -> user options for the debugger.
+#
+# if {options} isn't used, they're auto-placed before {exe}
+# or at the end if no {exe}
+
+my %debuggers = (
+ gdb => {
+ term => 1,
+ options => '-x {script} {exe}',
+ script => 'set args {args} < {input}',
+ },
+ ddd => {
+ interactive => 1,
+ options => '--command {script} {exe}',
+ script => 'set args {args} < {input}',
+ },
+ dbx => {
+ term => 1,
+ options => '-c "stop in main; run {exe} {args} < {input}"',
+ },
+ devenv => {
+ interactive => 1,
+ options => '/debugexe {exe} {args}',
+ },
+ windbg => {
+ interactive => 1,
+ options => '{exe} {args}',
+ },
+ lldb => {
+ term => 1,
+ options => '-s {script} {exe}',
+ script => 'process launch --stop-at-entry -- {args}',
+ },
+ valgrind => {
+ options => '--tool=memcheck --show-reachable=yes --leak-check=yes --num-callers=16 --quiet --suppressions='.cwd().'/valgrind.supp {exe} {args} --loose-wait-for-pos-timeout=1500',
+ pre => sub {
+ my $debug_libraries_path= "/usr/lib/debug";
+ $ENV{LD_LIBRARY_PATH} .= ":$debug_libraries_path" if -d $debug_libraries_path;
+ }
+ },
+ strace => {
+ options => '-f -o {log} {exe} {args}',
+ },
+ rr => {
+ options => '_RR_TRACE_DIR={log} rr record {exe} {args} --loose-skip-innodb-use-native-aio --loose-innodb-flush-method=fsync',
+ run => 'env',
+ pre => sub {
+ ::mtr_error('rr requires kernel.perf_event_paranoid <= 1')
+ if ::mtr_grab_file('/proc/sys/kernel/perf_event_paranoid') > 1;
+ }
+ },
+ valgdb => {
+ term => 1,
+ run => 'gdb',
+ options => '-x {script} {exe}',
+ script => <<EEE,
+py
+import subprocess,shlex,time
+valg=subprocess.Popen(shlex.split("""valgrind --tool=memcheck --show-reachable=yes --leak-check=yes --num-callers=16 --quiet --suppressions=valgrind.supp --vgdb-error=0 {exe} {args} --loose-wait-for-pos-timeout=1500"""))
+time.sleep(2)
+gdb.execute("target remote | vgdb --pid=" + str(valg.pid))
+EEE
+ pre => sub {
+ my $debug_libraries_path= "/usr/lib/debug";
+ $ENV{LD_LIBRARY_PATH} .= ":$debug_libraries_path" if -d $debug_libraries_path;
+ }
+ },
+
+ # aliases
+ vsjitdebugger => 'windbg',
+ ktrace => 'strace',
+);
+
+my %opts;
+my %opt_vals;
+my $debugger;
+my $boot_debugger;
+my $client_debugger;
+
+my $help = "\n\nOptions for running debuggers\n\n";
+
+for my $k (sort keys %debuggers) {
+ my $v = $debuggers{$k};
+ $v = $debuggers{$k} = $debuggers{$v} if not ref $v; # resolve aliases
+
+ sub register_opt($$$) {
+ my ($prefix, $name, $msg) = @_;
+ $opts{"$prefix$name=s"} = \$opt_vals{$prefix.$name};
+ $help .= wrap(sprintf(" %-23s", $prefix.$name), ' 'x25, "$msg under $name\n");
+ }
+
+ $v->{script} = '' unless $v->{script};
+ $v->{options} =~ s/(\{exe\}|$)/ {options} $&/ unless $v->{options} =~ /\{options\}/;
+
+ register_opt "", $k, "Start mysqld";
+ register_opt "client-", $k, "Start mysqltest client";
+ register_opt "boot-", $k, "Start bootstrap server";
+ register_opt "manual-", "$k", "Before running test(s) let user manually start mariadbd";
+}
+
+sub subst($%) {
+ use warnings FATAL => 'uninitialized';
+ my ($templ, %vars) = @_;
+ $templ =~ s/\{(\w+)\}/$vars{$1}/g;
+ $templ;
+}
+
+sub do_args($$$$$) {
+ my ($args, $exe, $input, $type, $opt) = @_;
+ my $k = $opt =~ /^(?:client|boot|manual)-(.*)$/ ? $1 : $opt;
+ my $v = $debuggers{$k};
+
+ # on windows mtr args are quoted (for system), otherwise not (for exec)
+ sub quote($) { $_[0] =~ /[; >]/ ? "\"$_[0]\"" : $_[0] }
+ sub unquote($) { $_[0] =~ s/^"(.*)"$/$1/; $_[0] }
+ sub quote_from_mtr($) { IS_WINDOWS() ? $_[0] : quote($_[0]) }
+ sub unquote_for_mtr($) { IS_WINDOWS() ? $_[0] : unquote($_[0]) }
+
+ my %vars = (
+ vardir => $::opt_vardir,
+ exe => $$exe,
+ args => join(' ', map { quote_from_mtr $_ } @$$args,
+ '--loose-debug-gdb', '--loose-skip-stack-trace'),
+ input => $input,
+ script => "$::opt_vardir/tmp/${k}init.$type",
+ log => "$::opt_vardir/log/$type.$k",
+ options => '',
+ );
+ my @params = split /;/, $opt_vals{$opt};
+ $vars{options} = shift @params if @params and $params[0] =~ /^-/;
+
+ my $script = join "\n", @params;
+ if ($v->{script}) {
+ ::mtr_tonewfile($vars{script}, subst($v->{script}, %vars)."\n".$script);
+ } elsif ($script) {
+ mtr_error "$k is not using a script file, nowhere to write the script \n---\n$script\n---";
+ }
+
+ my $options = subst($v->{options}, %vars);
+ @$$args = map { unquote_for_mtr $_ } $options =~ /("[^"]+"|\S+)/g;
+ my $run = $v->{run} || $k;
+
+ if ($opt =~ /^manual-/) {
+ print "\nTo start $k for $type, type in another window:\n";
+ print "$run $options\n";
+ $$exe= undef; # Indicate the exe should not be started
+ } elsif ($v->{term}) {
+ unshift @$$args, '-title', $type, '-e', $run;
+ $$exe = 'xterm';
+ } else {
+ $$exe = $run;
+ }
+}
+
+sub options() { %opts }
+sub help() { $help }
+
+sub fix_options(@) {
+ my $re=join '|', keys %opts;
+ $re =~ s/=s//g;
+ # FIXME: what is '=;'? What about ':s' to denote optional argument in register_opt()
+ map { $_ . (/^--($re)$/ and '=;') } @_;
+}
+
+sub pre_setup() {
+ my $used;
+ my $interactive;
+ my %options;
+ my %client_options;
+ my %boot_options;
+
+ my $embedded= $::opt_embedded_server ? ' with --embedded' : '';
+
+ for my $k (keys %debuggers) {
+ for my $opt ($k, "manual-$k", "boot-$k", "client-$k") {
+ my $val= $opt_vals{$opt};
+ if ($val) {
+ $used = 1;
+ $interactive ||= ($debuggers{$k}->{interactive} ||
+ $debuggers{$k}->{term} ||
+ ($opt =~ /^manual-/));
+ if ($debuggers{$k}->{pre}) {
+ $debuggers{$k}->{pre}->();
+ delete $debuggers{$k}->{pre};
+ }
+ if ($opt eq $k) {
+ $options{$opt}= $val;
+ $client_options{$opt}= $val
+ if $embedded;
+ } elsif ($opt eq "manual-$k") {
+ $options{$opt}= $val;
+ } elsif ($opt eq "boot-$k") {
+ $boot_options{$opt}= $val;
+ } elsif ($opt eq "client-$k") {
+ $client_options{$opt}= $val;
+ }
+ }
+ }
+ }
+
+ if ((keys %options) > 1) {
+ mtr_error "Multiple debuggers specified: ",
+ join (" ", map { "--$_" } keys %options);
+ }
+
+ if ((keys %boot_options) > 1) {
+ mtr_error "Multiple boot debuggers specified: ",
+ join (" ", map { "--$_" } keys %boot_options);
+ }
+
+ if ((keys %client_options) > 1) {
+ mtr_error "Multiple client debuggers specified: ",
+ join (" ", map { "--$_" } keys %client_options);
+ }
+
+ $debugger= (keys %options)[0];
+ $boot_debugger= (keys %boot_options)[0];
+ $client_debugger= (keys %client_options)[0];
+
+ if ($used) {
+ $ENV{ASAN_OPTIONS}= 'abort_on_error=1:'.($ENV{ASAN_OPTIONS} || '');
+ ::mtr_error("Can't use --extern when using debugger") if $ENV{USE_RUNNING_SERVER};
+
+ $::opt_retry= 1;
+ $::opt_retry_failure= 1;
+ $::opt_testcase_timeout= ($interactive ? 24 : 4) * 60; # in minutes
+ $::opt_suite_timeout= 24 * 60; # in minutes
+ $::opt_shutdown_timeout= ($interactive ? 24 * 60 : 3) * 60; # in seconds
+ $::opt_start_timeout= $::opt_shutdown_timeout; # in seconds
+ }
+}
+
+sub setup_boot_args($$$) {
+ my ($args, $exe, $input) = @_;
+ do_args($args, $exe, $input, 'bootstrap', $boot_debugger)
+ if defined $boot_debugger;
+}
+
+sub setup_client_args($$) {
+ my ($args, $exe) = @_;
+ do_args($args, $exe, IS_WINDOWS() ? 'NUL' : '/dev/null', 'client', $client_debugger)
+ if defined $client_debugger;
+}
+
+sub setup_args($$$) {
+ my ($args, $exe, $type) = @_;
+ do_args($args, $exe, IS_WINDOWS() ? 'NUL' : '/dev/null', $type, $debugger)
+ if defined $debugger;
+}
+
+1;
diff --git a/mysql-test/lib/My/File/Path.pm b/mysql-test/lib/My/File/Path.pm
new file mode 100644
index 00000000..fd3cf6dd
--- /dev/null
+++ b/mysql-test/lib/My/File/Path.pm
@@ -0,0 +1,225 @@
+# -*- cperl -*-
+# Copyright (c) 2007 MySQL AB, 2008, 2009 Sun Microsystems, Inc.
+# Use is subject to license terms.
+#
+# 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-1335 USA
+
+package My::File::Path;
+use strict;
+
+
+#
+# File::Path::rmtree has a problem with deleting files
+# and directories where it hasn't got read permission
+#
+# Patch this by installing a 'rmtree' function in local
+# scope that first chmod all files to 0777 before calling
+# the original rmtree function.
+#
+# This is almost gone in version 1.08 of File::Path -
+# but unfortunately some hosts still suffers
+# from this also in 1.08
+#
+
+use Exporter;
+use base "Exporter";
+our @EXPORT= qw /rmtree mkpath copytree make_readonly/;
+
+use File::Find;
+use File::Copy;
+use File::Spec;
+use Carp;
+use My::Handles;
+use My::Platform;
+
+sub rmtree {
+ my ($dir)= @_;
+ find( {
+ bydepth => 1,
+ no_chdir => 1,
+ wanted => sub {
+ my $name= $_;
+ if (!-l $name && -d _){
+ return if (rmdir($name) == 1);
+
+ chmod(0777, $name) or carp("couldn't chmod(0777, $name): $!");
+
+ return if (rmdir($name) == 1);
+
+ # Failed to remove the directory, analyze
+ carp("Couldn't remove directory '$name': $!");
+ My::Handles::show_handles($name);
+ } else {
+ return if (unlink($name) == 1);
+
+ chmod(0777, $name) or carp("couldn't chmod(0777, $name): $!");
+
+ return if (unlink($name) == 1);
+
+ carp("Couldn't delete file '$name': $!");
+ My::Handles::show_handles($name);
+ }
+ }
+ }, $dir );
+};
+
+
+use File::Basename;
+sub _mkpath_debug {
+ my ($message, $path, $dir, $err)= @_;
+
+ print "=" x 40, "\n";
+ print $message, "\n";
+ print "err: '$err'\n";
+ print "path: '$path'\n";
+ print "dir: '$dir'\n";
+
+ print "-" x 40, "\n";
+ my $dirname= dirname($path);
+ print "ls -l $dirname\n";
+ print `ls -l $dirname`, "\n";
+ print "-" x 40, "\n";
+ print "dir $dirname\n";
+ print `dir $dirname`, "\n";
+ print "-" x 40, "\n";
+ my $dirname2= dirname($dirname);
+ print "ls -l $dirname2\n";
+ print `ls -l $dirname2`, "\n";
+ print "-" x 40, "\n";
+ print "dir $dirname2\n";
+ print `dir $dirname2`, "\n";
+ print "-" x 40, "\n";
+ print "file exists\n" if (-e $path);
+ print "file is a plain file\n" if (-f $path);
+ print "file is a directory\n" if (-d $path);
+ print "-" x 40, "\n";
+ print "showing handles for $path\n";
+ My::Handles::show_handles($path);
+
+ print "=" x 40, "\n";
+
+}
+
+
+sub mkpath {
+ my $path;
+
+ die "Usage: mkpath(<path>)" unless @_ == 1;
+
+ foreach my $dir ( File::Spec->splitdir( @_ ) ) {
+ #print "dir: $dir\n";
+ if ($dir =~ /^[a-z]:/i){
+ # Found volume ie. C:
+ $path= $dir;
+ next;
+ }
+
+ $path= File::Spec->catdir($path, $dir);
+ #print "path: $path\n";
+
+ next if -d $path; # Path already exists and is a directory
+ croak("File already exists but is not a directory: '$path'") if -e $path;
+ next if mkdir($path);
+ _mkpath_debug("mkdir failed", $path, $dir, $!);
+
+ # mkdir failed, try one more time
+ next if mkdir($path);
+ _mkpath_debug("mkdir failed, second time", $path, $dir, $!);
+
+ # mkdir failed again, try two more time after sleep(s)
+ sleep(1);
+ next if mkdir($path);
+ _mkpath_debug("mkdir failed, third time", $path, $dir, $!);
+
+ sleep(1);
+ next if mkdir($path);
+ _mkpath_debug("mkdir failed, fourth time", $path, $dir, $!);
+
+ # Report failure and die
+ croak("Couldn't create directory '$path' ",
+ " after 4 attempts and 2 sleep(1): $!");
+ }
+};
+
+
+sub copytree {
+ my ($from_dir, $to_dir, $use_umask) = @_;
+
+ die "Usage: copytree(<fromdir>, <todir>, [<umask>])"
+ unless @_ == 2 or @_ == 3;
+
+ my $orig_umask;
+ if ($use_umask){
+ # Set new umask and remember the original
+ $orig_umask= umask(oct($use_umask));
+ }
+
+ mkpath("$to_dir");
+ opendir(DIR, "$from_dir")
+ or croak("Can't find $from_dir$!");
+ for(readdir(DIR)) {
+
+ next if "$_" eq "." or "$_" eq "..";
+
+ # Skip SCCS/ directories
+ next if "$_" eq "SCCS";
+
+ if ( -d "$from_dir/$_" )
+ {
+ copytree("$from_dir/$_", "$to_dir/$_");
+ next;
+ }
+
+ # Only copy plain files
+ next unless -f "$from_dir/$_";
+ copy("$from_dir/$_", "$to_dir/$_");
+ if (!$use_umask)
+ {
+ chmod(0666, "$to_dir/$_");
+ }
+ }
+ closedir(DIR);
+
+ if ($orig_umask){
+ # Set the original umask
+ umask($orig_umask);
+ }
+}
+
+
+sub make_readonly {
+ my ($dir) = @_;
+
+ die "Usage: make_readonly(<dir>])"
+ unless @_ == 1;
+
+ opendir(DIR, "$dir")
+ or croak("Can't find $dir$!");
+ for(readdir(DIR)) {
+
+ next if "$_" eq "." or "$_" eq "..";
+
+ if ( -d "$dir/$_" )
+ {
+ make_readonly("$dir/$_");
+ next;
+ }
+
+ # Only copy plain files
+ next unless -f "$dir/$_";
+ chmod 0444, "$dir/$_";
+ }
+ closedir(DIR);
+}
+1;
diff --git a/mysql-test/lib/My/Find.pm b/mysql-test/lib/My/Find.pm
new file mode 100644
index 00000000..b8c13752
--- /dev/null
+++ b/mysql-test/lib/My/Find.pm
@@ -0,0 +1,246 @@
+# -*- cperl -*-
+# Copyright (c) 2007, 2011, Oracle and/or its affiliates.
+#
+# 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-1335 USA
+
+
+package My::Find;
+
+#
+# Utility functions to find files in a MySQL source or bindist
+#
+
+use strict;
+use Carp;
+use My::Platform;
+
+use base qw(Exporter);
+our @EXPORT= qw(my_find_bin my_find_dir my_find_file NOT_REQUIRED);
+
+my $bin_extension= ".exe" if IS_WINDOWS;
+
+# Helper function to be used for fourth parameter to find functions
+sub NOT_REQUIRED { return 0; }
+
+#
+# my_find_bin - find an executable with "name_1...name_n" in
+# paths "path_1...path_n" and return the full path
+#
+# Example:
+# my $mysqld_exe= my_find_bin($basedir.
+# ["sql", "bin"],
+# ["mysqld", "mysqld-debug"]);
+# my $mysql_exe= my_find_bin($basedir,
+# ["client", "bin"],
+# "mysql");
+#
+#
+# To check if something exists, use the required parameter
+# set to 0, the function will return an empty string if the
+# binary is not found
+# my $mysql_exe= my_find_bin($basedir,
+# ["client", "bin"],
+# "mysql", NOT_REQUIRED);
+#
+# NOTE: The function honours MTR_VS_CONFIG environment variable
+#
+#
+sub my_find_bin {
+ my ($base, $paths, $names, $required)= @_;
+ croak "usage: my_find_bin(<base>, <paths>, <names>, [<required>])"
+ unless @_ == 4 or @_ == 3;
+
+ # -------------------------------------------------------
+ # Find and return the first executable
+ # -------------------------------------------------------
+ foreach my $path (my_build_path_list($base, $paths, $names, $bin_extension)) {
+ return $path if ( -x $path or (IS_WINDOWS and -f $path) );
+ }
+ if (defined $required and $required == NOT_REQUIRED){
+ # Return empty string to indicate not found
+ return "";
+ }
+ find_error($base, $paths, $names);
+}
+
+
+#
+# my_find_file - find a file with "name_1...name_n" in
+# paths "path_1...path_n" and return the full path
+#
+# Example:
+# my $mysqld_exe= my_find_file($basedir.
+# ["sql", "bin"],
+# "filename");
+#
+#
+# Also supports NOT_REQUIRED flag
+#
+# NOTE: The function honours MTR_VS_CONFIG environment variable
+#
+#
+sub my_find_file {
+ my ($base, $paths, $names, $required)= @_;
+ croak "usage: my_find_file(<base>, <paths>, <names>, [<required>])"
+ unless @_ == 4 or @_ == 3;
+
+ # -------------------------------------------------------
+ # Find and return the first executable
+ # -------------------------------------------------------
+ foreach my $path (my_build_path_list($base, $paths, $names, $bin_extension)) {
+ return $path if ( -f $path );
+ }
+ if (defined $required and $required == NOT_REQUIRED){
+ # Return empty string to indicate not found
+ return "";
+ }
+ find_error($base, $paths, $names);
+}
+
+
+#
+# my_find_dir - find the existing directories in one of
+# the given paths. Returns the first found in the scalar context
+# and all of them in the list context.
+#
+# Example:
+# my $charset_set= my_find_dir($basedir,
+# ["mysql/share","sql/share", "share"],
+# ["charset"]);
+# or
+# my $charset_set= my_find_dir($basedir,
+# ['client_release', 'client_debug',
+# 'client', 'bin']);
+#
+# NOTE: The function honours MTR_VS_CONFIG environment variable
+#
+#
+sub my_find_dir {
+ my ($base, $paths, $dirs, $required)= @_;
+ croak "usage: my_find_dir(<base>, <paths>[, <dirs>[, <required>]])"
+ unless (@_ >= 2 and @_ <= 4);
+
+ my @all;
+ foreach my $path (my_build_path_list($base, $paths, $dirs)) {
+ next unless -d $path;
+ return $path unless wantarray;
+ push @all, $path;
+ }
+ return @all if @all;
+ return wantarray ? () : "" if defined $required and $required == NOT_REQUIRED;
+ find_error($base, $paths, $dirs);
+}
+
+
+sub my_build_path_list {
+ my ($base, $paths, $names, $extension)= @_;
+
+ # Convert the arguments into two normal arrays to ease
+ # further mappings
+ my (@names, @paths);
+ push(@names, ref $names eq "ARRAY" ? @$names : $names);
+ push(@paths, ref $paths eq "ARRAY" ? @$paths : $paths);
+
+ #print "base: $base\n";
+ #print "names: @names\n";
+ #print "paths: @paths\n";
+
+ # User can select to look in a special build dir
+ # which is a subdirectory of any of the paths
+ my @extra_dirs;
+ my $build_dir= $::multiconfig || $ENV{MTR_VS_CONFIG} || $ENV{MTR_BUILD_DIR};
+ push(@extra_dirs, $build_dir) if defined $build_dir;
+
+ if (defined $extension){
+ # Append extension to names, if name does not already have extension
+ map { $_.=$extension unless /\.(.*)+$/ } @names;
+ }
+
+ # -------------------------------------------------------
+ # CMake generator specific (Visual Studio and Xcode have multimode builds)
+ # -------------------------------------------------------
+
+ # Add the default extra build dirs unless a specific one has
+ # already been selected
+ push(@extra_dirs,
+ ("Release",
+ "Relwithdebinfo",
+ "Debug")) if @extra_dirs == 0;
+
+
+ #print "extra_build_dir: @extra_dirs\n";
+
+ # -------------------------------------------------------
+ # Build cross product of "paths * extra_build_dirs"
+ # -------------------------------------------------------
+ push(@paths, map { my $path= $_;
+ map { "$path/$_" } @extra_dirs
+ } @paths);
+ #print "paths: @paths\n";
+
+ # -------------------------------------------------------
+ # Build cross product of "paths * names"
+ # -------------------------------------------------------
+ @paths= map { my $path= $_;
+ map { "$path/$_" } @names
+ } @paths;
+ #print "paths: @paths\n";
+
+ # -------------------------------------------------------
+ # Prepend base to all paths
+ # -------------------------------------------------------
+ @paths= map { "$base/$_" } @paths;
+ #print "paths: @paths\n";
+
+ # -------------------------------------------------------
+ # Glob all paths to expand wildcards
+ # -------------------------------------------------------
+ @paths= map { glob("$_") } @paths;
+ #print "paths: @paths\n";
+
+ # -------------------------------------------------------
+ # Return the list of paths
+ # -------------------------------------------------------
+ return @paths;
+}
+
+
+sub commify {
+ return
+ (@_ == 0) ? '' :
+ (@_ == 1) ? $_[0] :
+ (@_ == 2) ? join(" or ", @_) :
+ join(", ", @_[0..($#_-1)], "or $_[-1]");
+
+}
+
+
+sub fnuttify {
+ return map('\''.$_.'\'', @_);
+}
+
+
+sub find_error {
+ my ($base, $paths, $names)= @_;
+
+ my (@names, @paths);
+ push(@names, ref $names eq "ARRAY" ? @$names : $names);
+ push(@paths, ref $paths eq "ARRAY" ? @$paths : $paths);
+
+ croak "** ERROR: Could not find ",
+ commify(fnuttify(@names)), " in ",
+ commify(fnuttify(my_build_path_list($base, $paths, $names))), "\n";
+}
+
+1;
diff --git a/mysql-test/lib/My/Handles.pm b/mysql-test/lib/My/Handles.pm
new file mode 100644
index 00000000..e23d3b75
--- /dev/null
+++ b/mysql-test/lib/My/Handles.pm
@@ -0,0 +1,71 @@
+# -*- cperl -*-
+# Copyright (c) 2008, 2010, 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-1335 USA
+
+package My::Handles;
+
+
+use strict;
+use Carp;
+
+use My::Platform;
+
+my $handle_exe;
+
+sub import {
+ my $self = shift;
+ my $params = shift;
+ return if (!IS_WINDOWS || $handle_exe);
+ # Check if handle.exe is available
+ # Pass switch to accept the EULA to avoid hanging
+ # if the program hasn't been run before.
+ my $list= `handle.exe -? -accepteula 2>&1`;
+ foreach my $line (split('\n', $list))
+ {
+ $handle_exe= "$2.$3"
+ if ($line =~ /(Nth|H)andle v([0-9]*)\.([0-9]*)/);
+ }
+ if ($handle_exe && (!$params || !$params->{suppress_init_messages})){
+ print "Found handle.exe version $handle_exe\n";
+ }
+}
+
+
+sub show_handles
+{
+ my ($dir)= @_;
+ return unless $handle_exe;
+ return unless $dir;
+
+ $dir= native_path($dir);
+
+ # Get a list of open handles in a particular directory
+ my $list= `handle.exe "$dir" 2>&1` or return;
+
+ foreach my $line (split('\n', $list))
+ {
+ return if ($line =~ /No matching handles found/);
+ }
+
+ print "\n";
+ print "=" x 50, "\n";
+ print "Open handles in '$dir':\n";
+ print "$list\n";
+ print "=" x 50, "\n\n";
+
+ return;
+}
+
+1;
diff --git a/mysql-test/lib/My/Options.pm b/mysql-test/lib/My/Options.pm
new file mode 100644
index 00000000..b3ae64cb
--- /dev/null
+++ b/mysql-test/lib/My/Options.pm
@@ -0,0 +1,179 @@
+# -*- cperl -*-
+# Copyright (c) 2008, 2010, 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-1335 USA
+
+
+package My::Options;
+
+#
+# Utility functions to work with list of options
+#
+
+use strict;
+
+
+sub same($$) {
+ my $l1= shift;
+ my $l2= shift;
+ return compare($l1,$l2) == 0;
+}
+
+
+sub compare ($$) {
+ 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
+}
+
+
+sub _split_option {
+ my ($option)= @_;
+ if ($option=~ /^--(.*)=(.*)$/){
+ return ($1, $2);
+ }
+ elsif ($option=~ /^--(.*)$/){
+ return ($1, undef)
+ }
+ elsif ($option=~ /^\$(.*)$/){ # $VAR
+ return ($1, undef)
+ }
+ elsif ($option=~ /^(.*)=(.*)$/){
+ return ($1, $2)
+ }
+ die "Unknown option format '$option'";
+}
+
+
+sub _build_option {
+ my ($name, $value)= @_;
+ if ($name =~ /^O, /){
+ return "-".$name."=".$value;
+ }
+ elsif ($value){
+ return "--".$name."=".$value;
+ }
+ return "--".$name;
+}
+
+
+#
+# Compare two list of options and return what would need
+# to be done to get the server running with the new settings
+#
+sub diff {
+ my ($from_opts, $to_opts)= @_;
+
+ my %from;
+ foreach my $from (@$from_opts)
+ {
+ my ($opt, $value)= _split_option($from);
+ next unless defined($opt);
+ $from{$opt}= $value;
+ }
+
+ #print "from: ", %from, "\n";
+
+ my %to;
+ foreach my $to (@$to_opts)
+ {
+ my ($opt, $value)= _split_option($to);
+ next unless defined($opt);
+ $to{$opt}= $value;
+ }
+
+ #print "to: ", %to, "\n";
+
+ # Remove the ones that are in both lists
+ foreach my $name (keys %from){
+ if (exists $to{$name} and $to{$name} eq $from{$name}){
+ #print "removing '$name' from both lists\n";
+ delete $to{$name};
+ delete $from{$name};
+ }
+ }
+
+ #print "from: ", %from, "\n";
+ #print "to: ", %to, "\n";
+
+ # Add all keys in "to" to result
+ my @result;
+ foreach my $name (keys %to){
+ push(@result, _build_option($name, $to{$name}));
+ }
+
+ # Add all keys in "from" that are not in "to"
+ # to result as "set to default"
+ foreach my $name (keys %from){
+ if (not exists $to{$name}) {
+ push(@result, _build_option($name, "default"));
+ }
+ }
+
+ return @result;
+}
+
+
+sub is_subset {
+ my ($set, $subset)= @_;
+ my %cache = map { join('=', _split_option($_)), 1 } @$set;
+
+ for (@$subset){
+ my ($name, $value)= _split_option($_);
+ return 0 unless $cache{"$name=$value"};
+ }
+
+ return 1;
+}
+
+
+sub toSQL {
+ my (@options)= @_;
+ my @sql;
+
+ foreach my $option (@options) {
+ my ($sql_name, $value)= _split_option($option);
+ #print "name: $sql_name\n";
+ #print "value: $value\n";
+ $sql_name=~ s/-/_/g;
+ push(@sql, "SET GLOBAL $sql_name=$value");
+ }
+ return join("; ", @sql);
+}
+
+
+sub toStr {
+ my $name= shift;
+ return "$name: ",
+ "['", join("', '", @_), "']\n";
+}
+
+
+1;
+
diff --git a/mysql-test/lib/My/Platform.pm b/mysql-test/lib/My/Platform.pm
new file mode 100644
index 00000000..2b32ef87
--- /dev/null
+++ b/mysql-test/lib/My/Platform.pm
@@ -0,0 +1,299 @@
+# -*- cperl -*-
+# Copyright (c) 2008 MySQL AB, 2008, 2009 Sun Microsystems, Inc.
+# Use is subject to license terms.
+#
+# 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-1335 USA
+
+package My::Platform;
+
+use strict;
+use File::Basename;
+use File::Path;
+use Carp;
+
+use base qw(Exporter);
+our @EXPORT= qw(IS_CYGWIN IS_MSYS IS_WINDOWS IS_WIN32PERL IS_AIX
+ native_path posix_path mixed_path
+ check_socket_path_length process_alive open_for_append);
+
+BEGIN {
+ if ($^O eq "cygwin") {
+ # Make sure cygpath works
+ if ((system("cygpath > /dev/null 2>&1") >> 8) != 1){
+ die "Could not execute 'cygpath': $!";
+ }
+ eval 'sub IS_CYGWIN { 1 }';
+ eval 'sub IS_MSYS { 0 }';
+ }
+ elsif ($^O eq "msys") {
+ eval 'sub IS_CYGWIN { 1 }';
+ eval 'sub IS_MSYS { 1 }';
+ }
+ else {
+ eval 'sub IS_CYGWIN { 0 }';
+ eval 'sub IS_MSYS { 0 }';
+ }
+ if ($^O eq "MSWin32") {
+ eval 'sub IS_WIN32PERL { 1 }';
+ }
+ else {
+ eval 'sub IS_WIN32PERL { 0 }';
+ }
+}
+
+BEGIN {
+ if (IS_CYGWIN or IS_WIN32PERL) {
+ eval 'sub IS_WINDOWS { 1 }';
+ }
+ else {
+ eval 'sub IS_WINDOWS { 0 }';
+ }
+}
+
+BEGIN {
+ if ($^O eq "aix") {
+ eval 'sub IS_AIX { 1 }';
+ }
+ else {
+ eval 'sub IS_AIX { 0 }';
+ }
+}
+
+
+#
+# native_path
+# Convert from path format used by perl to the underlying
+# operating systems format
+#
+# NOTE
+# Used when running windows binaries (that expect windows paths)
+# in cygwin perl (that uses unix paths)
+#
+
+use Memoize;
+if (!IS_WIN32PERL){
+ memoize('mixed_path');
+ memoize('native_path');
+ memoize('posix_path');
+}
+
+sub mixed_path {
+ my ($path)= @_;
+ if (IS_CYGWIN){
+ return unless defined $path;
+ my $cmd= "cygpath -m $path";
+ $path= `$cmd` or
+ print "Failed to run: '$cmd', $!\n";
+ chomp $path;
+ }
+ return $path;
+}
+
+sub native_path {
+ my ($path)= @_;
+ if (IS_CYGWIN) {
+ # \\\\ protects against 2 expansions (just for the case)
+ $path=~ s/\/+|\\+/\\\\\\\\/g;
+ }
+ elsif (IS_WINDOWS) {
+ $path=~ s/\/+/\\/g;
+ }
+ return $path;
+}
+
+sub posix_path {
+ my ($path)= @_;
+ if (IS_CYGWIN){
+ return unless defined $path;
+ $path= `cygpath $path`;
+ chomp $path;
+ }
+ return $path;
+}
+
+use File::Temp qw /tempdir/;
+
+sub check_socket_path_length {
+ my ($path)= @_;
+
+ return 0 if IS_WINDOWS;
+ # This may not be true, but we can't test for it on AIX due to Perl bug
+ # See Bug #45771
+ return 0 if ($^O eq 'aix');
+ # See Debian bug #670722 - failing on kFreeBSD even after setting short path
+ return 0 if $^O eq 'gnukfreebsd' and length $path < 40;
+ # GNU/Hurd doesn't have hostpath(), but no limitation either
+ return 0 if $^O eq 'gnu';
+
+ require IO::Socket::UNIX;
+
+ my $truncated= undef;
+
+ # Create a tempfile name with same length as "path"
+ my $tmpdir = tempdir( CLEANUP => 0);
+ my $len = length($path) - length($tmpdir) - 1;
+ my $testfile = $tmpdir . "/" . "x" x ($len > 0 ? $len : 1);
+ my $sock;
+ eval {
+ $sock= new IO::Socket::UNIX
+ (
+ Local => $testfile,
+ Listen => 1,
+ );
+ $truncated= 1; # Be negatvie
+
+ die "Could not create UNIX domain socket: $!"
+ unless defined $sock;
+
+ die "UNIX domain socket path was truncated"
+ unless ($testfile eq $sock->hostpath());
+
+ $truncated= 0; # Yes, it worked!
+
+ };
+
+ die "Unexpected failure when checking socket path length: $@"
+ if $@ and not defined $truncated;
+
+ $sock= undef; # Close socket
+ rmtree($tmpdir); # Remove the tempdir and any socket file created
+ return $truncated;
+}
+
+
+sub process_alive {
+ my ($pid)= @_;
+ die "usage: process_alive(pid)" unless $pid;
+
+ return kill(0, $pid) unless IS_WINDOWS;
+
+ my @list= split(/,/, `tasklist /FI "PID eq $pid" /NH /FO CSV`);
+ my $ret_pid= eval($list[1]);
+ return ($ret_pid == $pid);
+}
+
+
+
+use Symbol qw( gensym );
+
+use if $^O eq 'MSWin32', 'Win32API::File', qw( CloseHandle CreateFile GetOsFHandle OsFHandleOpen OPEN_ALWAYS FILE_APPEND_DATA
+ FILE_SHARE_READ FILE_SHARE_WRITE FILE_SHARE_DELETE );
+use if $^O eq 'MSWin32', 'Win32::API';
+
+use constant WIN32API_FILE_NULL => [];
+
+# Open a file for append
+# On Windows we use CreateFile with FILE_APPEND_DATA
+# to insure that writes are atomic, not interleaved
+# with writes by another processes.
+sub open_for_append
+{
+ my ($file) = @_;
+ my $fh = gensym();
+
+ if (IS_WIN32PERL)
+ {
+ my $handle;
+ if (!($handle = CreateFile(
+ $file,
+ FILE_APPEND_DATA(),
+ FILE_SHARE_READ()|FILE_SHARE_WRITE()|FILE_SHARE_DELETE(),
+ WIN32API_FILE_NULL,
+ OPEN_ALWAYS(),# Create if doesn't exist.
+ 0,
+ WIN32API_FILE_NULL,
+ )))
+ {
+ return undef;
+ }
+
+ if (!OsFHandleOpen($fh, $handle, 'wat'))
+ {
+ CloseHandle($handle);
+ return undef;
+ }
+ return $fh;
+ }
+
+ open($fh,">>",$file) or return undef;
+ return $fh;
+}
+
+
+sub check_cygwin_subshell
+{
+ # Only pipe (or sh-expansion) is fed to /bin/sh
+ my $out= `echo %comspec%|cat`;
+ return ($out =~ /\bcmd.exe\b/) ? 0 : 1;
+}
+
+sub install_shell_wrapper()
+{
+ system("rm -f /bin/sh.exe") and die $!;
+ my $wrapper= <<'EOF';
+#!/bin/bash
+if [[ -n "$MTR_PERL" && "$1" = "-c" ]]; then
+ shift
+ exec $(cygpath -m "$COMSPEC") /C "$@"
+fi
+exec /bin/bash "$@"
+EOF
+ open(OUT, '>', "/bin/sh") or die "/bin/sh: $!\n";
+ print OUT $wrapper;
+ close(OUT);
+ system("chmod +x /bin/sh") and die $!;
+ print "Cygwin subshell wrapper /bin/sh was installed, please restart MTR!\n";
+ exit(0);
+}
+
+sub uninstall_shell_wrapper()
+{
+ system("rm -f /bin/sh") and die $!;
+ system("cp /bin/bash.exe /bin/sh.exe") and die $!;
+}
+
+sub cygwin_subshell_fix
+{
+ my ($opt_name, $opt_value)= @_;
+ if ($opt_name ne "cygwin-subshell-fix") {
+ confess "Wrong option name: ${opt_name}";
+ }
+ if ($opt_value eq "do") {
+ if (check_cygwin_subshell()) {
+ install_shell_wrapper();
+ } else {
+ print "Cygwin subshell fix was already installed, skipping...\n";
+ }
+ } elsif ($opt_value eq "remove") {
+ if (check_cygwin_subshell()) {
+ print "Cygwin subshell fix was already uninstalled, skipping...\n";
+ } else {
+ uninstall_shell_wrapper();
+ }
+ } else {
+ die "Wrong --cygwin-subshell-fix value: ${opt_value} (expected do/remove)";
+ }
+}
+
+sub options
+{
+ if (IS_CYGWIN) {
+ return ('cygwin-subshell-fix=s' => \&cygwin_subshell_fix);
+ } else {
+ return ();
+ }
+}
+
+
+1;
diff --git a/mysql-test/lib/My/SafeProcess.pm b/mysql-test/lib/My/SafeProcess.pm
new file mode 100644
index 00000000..e3b46b37
--- /dev/null
+++ b/mysql-test/lib/My/SafeProcess.pm
@@ -0,0 +1,640 @@
+# -*- cperl -*-
+# Copyright (c) 2007, 2011, Oracle and/or its affiliates.
+# Copyright (c) 2009, 2011 Monty Program Ab
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU Library 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
+# Library 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-1335 USA
+
+package My::SafeProcess;
+
+#
+# Class that encapsulates process creation, monitoring and cleanup
+#
+# Spawns a monitor process which spawns a new process locally or
+# remote using subclasses My::Process::Local or My::Process::Remote etc.
+#
+# The monitor process runs a simple event loop more or less just
+# waiting for a reason to zap the process it monitors. Thus the user
+# of this class does not need to care about process cleanup, it's
+# handled automatically.
+#
+# The monitor process wait for:
+# - the parent process to close the pipe, in that case it
+# will zap the "monitored process" and exit
+# - the "monitored process" to exit, in which case it will exit
+# itself with same exit code as the "monitored process"
+# - the parent process to send the "shutdown" signal in which case
+# monitor will kill the "monitored process" hard and exit
+#
+#
+# When used it will look something like this:
+# $> ps
+# [script.pl]
+# - [monitor for `mysqld`]
+# - [mysqld]
+# - [monitor for `mysqld`]
+# - [mysqld]
+# - [monitor for `mysqld`]
+# - [mysqld]
+#
+#
+
+use strict;
+use Carp;
+use POSIX qw(WNOHANG);
+
+use My::SafeProcess::Base;
+use base 'My::SafeProcess::Base';
+
+use My::Find;
+use My::Platform;
+
+my %running;
+my $_verbose= 0;
+my $start_exit= 0;
+
+END {
+ # Kill any children still running
+ for my $proc (values %running){
+ if ( $proc->is_child($$) and ! $start_exit){
+ #print "Killing: $proc\n";
+ if ($proc->wait_one(0)){
+ $proc->kill();
+ }
+ }
+ }
+}
+
+
+sub is_child {
+ my ($self, $parent_pid)= @_;
+ croak "usage: \$safe_proc->is_child()" unless (@_ == 2 and ref $self);
+ return ($self->{PARENT} == $parent_pid);
+}
+
+
+our @safe_process_cmd;
+my $safe_kill;
+my $bindir;
+
+if(defined $ENV{MTR_BINDIR})
+{
+ # This is an out-of-source build. Build directory
+ # is given in MTR_BINDIR env.variable
+ $bindir = $ENV{MTR_BINDIR}."/mysql-test";
+}
+else
+{
+ use Cwd;
+ $bindir = getcwd();
+}
+
+# Find the safe process binary or script
+sub find_bin {
+ if (IS_WINDOWS)
+ {
+ # Use my_safe_process.exe
+ my $exe= my_find_bin($bindir, ["lib/My/SafeProcess", "My/SafeProcess"],
+ "my_safe_process");
+ push(@safe_process_cmd, $exe);
+
+ # Use my_safe_kill.exe
+ $safe_kill= my_find_bin($bindir, "lib/My/SafeProcess", "my_safe_kill");
+ }
+ else
+ {
+ # Use my_safe_process
+ my $exe= my_find_bin($bindir, ["lib/My/SafeProcess", "My/SafeProcess"],
+ "my_safe_process");
+ push(@safe_process_cmd, $exe);
+ }
+}
+
+
+sub new {
+ my $class= shift;
+
+ my %opts=
+ (
+ verbose => 0,
+ @_
+ );
+
+ my $path = delete($opts{'path'}) or croak "path required @_";
+ my $args = delete($opts{'args'}) or croak "args required @_";
+ my $input = delete($opts{'input'});
+ my $output = delete($opts{'output'});
+ my $error = delete($opts{'error'});
+ my $verbose = delete($opts{'verbose'}) || $::opt_verbose;
+ my $nocore = delete($opts{'nocore'});
+ my $host = delete($opts{'host'});
+ my $shutdown = delete($opts{'shutdown'});
+ my $user_data= delete($opts{'user_data'});
+ my $envs = delete($opts{'envs'});
+
+# if (defined $host) {
+# $safe_script= "lib/My/SafeProcess/safe_process_cpcd.pl";
+# }
+
+ if (IS_CYGWIN){
+ $path= mixed_path($path);
+ $input= mixed_path($input);
+ $output= mixed_path($output);
+ $error= mixed_path($error);
+ }
+
+ my @safe_args;
+ my ($safe_path, $safe_script)= @safe_process_cmd;
+ push(@safe_args, $safe_script) if defined $safe_script;
+
+ push(@safe_args, "--verbose") if $verbose > 0;
+ push(@safe_args, "--nocore") if $nocore;
+
+ # Point the safe_process at the right parent if running on cygwin
+ push(@safe_args, "--parent-pid=".Cygwin::pid_to_winpid($$)) if IS_CYGWIN;
+
+ foreach my $env_var (@$envs) {
+ croak("Missing = in env string") unless $env_var =~ /=/;
+ croak("Env string $env_var seen, probably missing value for --mysqld-env")
+ if $env_var =~ /^--/;
+ push @safe_args, "--env $env_var";
+ }
+
+ push(@safe_args, "--");
+ push(@safe_args, $path); # The program safe_process should execute
+
+ if ($start_exit) { # Bypass safe_process instead, start program directly
+ @safe_args= ();
+ $safe_path= $path;
+ }
+ push(@safe_args, @$$args);
+
+ print "### safe_path: ", $safe_path, " ", join(" ", @safe_args), "\n"
+ if $verbose > 1;
+
+ my $pid= create_process(
+ path => $safe_path,
+ input => $input,
+ output => $output,
+ error => $error,
+ append => $opts{append},
+ args => \@safe_args,
+ );
+
+ my $name = delete($opts{'name'}) || "SafeProcess$pid";
+ my $proc= bless
+ ({
+ SAFE_PID => $pid,
+ SAFE_WINPID => $pid, # Inidicates this is always a real process
+ SAFE_NAME => $name,
+ SAFE_SHUTDOWN => $shutdown,
+ PARENT => $$,
+ SAFE_USER_DATA => $user_data,
+ }, $class);
+
+ # Put the new process in list of running
+ $running{$pid}= $proc;
+ return $proc;
+
+}
+
+
+sub run {
+ my $proc= new(@_);
+ $proc->wait_one();
+ return $proc->exit_status();
+}
+
+#
+# Shutdown process nicely, and wait for shutdown_timeout seconds
+# If processes hasn't shutdown, kill them hard and wait for return
+#
+sub shutdown {
+ my $shutdown_timeout= shift;
+ my @processes= @_;
+ _verbose("shutdown, timeout: $shutdown_timeout, @processes");
+
+ return if (@processes == 0);
+
+ # Call shutdown function if process has one, else
+ # use kill
+ foreach my $proc (@processes){
+ _verbose(" proc: $proc");
+ my $shutdown= $proc->{SAFE_SHUTDOWN};
+ if ($shutdown_timeout > 0 and defined $shutdown){
+ $shutdown->();
+ $proc->{WAS_SHUTDOWN}= 1;
+ }
+ else {
+ $proc->start_kill();
+ }
+ }
+
+ my @kill_processes= ();
+
+ # Wait max shutdown_timeout seconds for those process
+ # that has been shutdown
+ foreach my $proc (@processes){
+ next unless $proc->{WAS_SHUTDOWN};
+ my $ret= $proc->wait_one($shutdown_timeout);
+ if ($ret != 0) {
+ push(@kill_processes, $proc);
+ }
+ # Only wait for the first process with shutdown timeout
+ $shutdown_timeout= 0;
+ }
+
+ # Wait infinitely for those process
+ # that has been killed
+ foreach my $proc (@processes){
+ next if $proc->{WAS_SHUTDOWN};
+ my $ret= $proc->wait_one(undef);
+ if ($ret != 0) {
+ warn "Wait for killed process failed!";
+ push(@kill_processes, $proc);
+ # Try one more time, best option...
+ }
+ }
+
+ # Return if all servers has exited
+ return if (@kill_processes == 0);
+
+ foreach my $proc (@kill_processes){
+ $proc->start_kill();
+ }
+
+ foreach my $proc (@kill_processes){
+ $proc->wait_one(undef);
+ }
+
+ return;
+}
+
+
+sub _winpid ($) {
+ my ($pid)= @_;
+
+ # In win32 perl, the pid is already the winpid
+ return $pid unless IS_CYGWIN;
+
+ # In cygwin, the pid is the pseudo process ->
+ # get the real winpid of my_safe_process
+ return Cygwin::pid_to_winpid($pid);
+}
+
+
+#
+# Tell the process to die as fast as possible
+#
+sub start_kill {
+ my ($self)= @_;
+ croak "usage: \$safe_proc->start_kill()" unless (@_ == 1 and ref $self);
+ _verbose("start_kill: $self");
+ my $ret= 1;
+
+ my $pid= $self->{SAFE_PID};
+ die "INTERNAL ERROR: no pid" unless defined $pid;
+
+ if (IS_WINDOWS and defined $self->{SAFE_WINPID})
+ {
+ die "INTERNAL ERROR: no safe_kill" unless defined $safe_kill;
+
+ my $winpid= _winpid($pid);
+ $ret= system($safe_kill, $winpid) >> 8;
+
+ if ($ret == 3){
+ print "Couldn't open the winpid: $winpid ".
+ "for pid: $pid, try one more time\n";
+ sleep(1);
+ $winpid= _winpid($pid);
+ $ret= system($safe_kill, $winpid) >> 8;
+ print "Couldn't open the winpid: $winpid ".
+ "for pid: $pid, continue and see what happens...\n";
+ }
+ }
+ else
+ {
+ $pid= $self->{SAFE_PID};
+ die "Can't kill not started process" unless defined $pid;
+ $ret= kill("TERM", $pid);
+ }
+
+ return $ret;
+}
+
+
+sub dump_core {
+ my ($self)= @_;
+ my $pid= $self->{SAFE_PID};
+ die "Can't get core from not started process" unless defined $pid;
+
+ if (IS_WINDOWS) {
+ system("$safe_kill $pid dump");
+ return 1;
+ }
+
+ _verbose("Sending ABRT to $self");
+ kill ("ABRT", $pid);
+ return 1;
+}
+
+
+#
+# Kill the process as fast as possible
+# and wait for it to return
+#
+sub kill {
+ my ($self)= @_;
+ croak "usage: \$safe_proc->kill()" unless (@_ == 1 and ref $self);
+
+ $self->start_kill();
+ $self->wait_one();
+ return 1;
+}
+
+
+sub _collect {
+ my ($self, $exit_code)= @_;
+
+ $self->{EXIT_STATUS}= $exit_code;
+ _verbose("_collect: $self");
+
+ # Take the process out of running list
+ my $pid= $self->{SAFE_PID};
+ die unless delete($running{$pid});
+}
+
+
+# Wait for process to exit
+# optionally with a timeout
+#
+# timeout
+# undef -> wait blocking infinitely
+# 0 -> just poll with WNOHANG
+# >0 -> wait blocking for max timeout seconds
+#
+# RETURN VALUES
+# 0 Not running
+# 1 Still running
+#
+sub wait_one {
+ my ($self, $timeout, $keep)= @_;
+ croak "usage: \$safe_proc->wait_one([timeout] [, keep])" unless ref $self;
+
+ _verbose("wait_one $self, $timeout, $keep");
+
+ if ( ! defined($self->{SAFE_PID}) ) {
+ # No pid => not running
+ _verbose("No pid => not running");
+ return 0;
+ }
+
+ if ( defined $self->{EXIT_STATUS} ) {
+ # Exit status already set => not running
+ _verbose("Exit status already set => not running");
+ return 0;
+ }
+
+ my $pid= $self->{SAFE_PID};
+
+ my $use_alarm;
+ my $blocking;
+ if (defined $timeout)
+ {
+ if ($timeout == 0)
+ {
+ # 0 -> just poll with WNOHANG
+ $blocking= 0;
+ $use_alarm= 0;
+ }
+ else
+ {
+ # >0 -> wait blocking for max timeout seconds
+ $blocking= 1;
+ $use_alarm= 1;
+ }
+ }
+ else
+ {
+ # undef -> wait blocking infinitely
+ $blocking= 1;
+ $use_alarm= 0;
+ }
+ #_verbose("blocking: $blocking, use_alarm: $use_alarm");
+
+ my $retpid;
+ my $exit_code;
+ eval
+ {
+ # alarm should break the wait
+ local $SIG{ALRM}= sub { die "waitpid timeout"; };
+
+ alarm($timeout) if $use_alarm;
+
+ $retpid= waitpid($pid, $blocking ? 0 : &WNOHANG);
+ $exit_code= $?;
+
+ alarm(0) if $use_alarm;
+ };
+
+ if ($@)
+ {
+ die "Got unexpected: $@" if ($@ !~ /waitpid timeout/);
+ if (!defined $retpid) {
+ # Got timeout
+ _verbose("Got timeout");
+ return 1;
+ }
+ # Got pid _and_ alarm, continue
+ _verbose("Got pid and alarm, continue");
+ }
+
+ if ( $retpid == 0 ) {
+ # 0 => still running
+ _verbose("0 => still running");
+ return 1;
+ }
+
+ #if ( not $blocking and $retpid == -1 ) {
+ # # still running
+ # _verbose("still running");
+ # return 1;
+ #}
+
+ #warn "wait_one: expected pid $pid but got $retpid"
+ # unless( $retpid == $pid );
+
+ $self->_collect($exit_code) unless $keep;
+ return 0;
+}
+
+
+#
+# Wait for any process to exit
+#
+# Returns a reference to the SafeProcess that
+# exited or undefined
+#
+sub wait_any {
+ my $ret_pid;
+ my $exit_code;
+
+ if (IS_WIN32PERL) {
+ # Can't wait for -1 => use a polling loop
+ do {
+ Win32::Sleep(10); # 10 milli seconds
+ foreach my $pid (keys %running){
+ $ret_pid= waitpid($pid, &WNOHANG);
+ last if $pid == $ret_pid;
+ }
+ } while ($ret_pid == 0);
+ $exit_code= $?;
+ }
+ else
+ {
+ $ret_pid= waitpid(-1, 0);
+ if ($ret_pid <= 0){
+ # No more processes to wait for
+ print STDERR "wait_any, got invalid pid: $ret_pid\n";
+ return undef;
+ }
+ $exit_code= $?;
+ }
+
+ # Look it up in "running" table
+ my $proc= $running{$ret_pid};
+ unless (defined $proc){
+ print STDERR "Could not find pid: $ret_pid in running list\n";
+ print STDERR "running: ". join(", ", keys(%running)). "\n";
+ return undef;
+ }
+ $proc->_collect($exit_code);
+ return $proc;
+}
+
+
+#
+# Wait for any process to exit, or a timeout
+#
+# Returns a reference to the SafeProcess that
+# exited or a pseudo-process with $proc->{timeout} == 1
+#
+
+sub wait_any_timeout {
+ my $class= shift;
+ my $timeout= shift;
+ my $proc;
+ my $millis=10;
+
+ do {
+ ::mtr_milli_sleep($millis);
+ # Slowly increse interval up to max. 1 second
+ $millis++ if $millis < 1000;
+ # Return a "fake" process for timeout
+ if (::has_expired($timeout)) {
+ $proc= bless
+ ({
+ SAFE_PID => 0,
+ SAFE_NAME => "timer",
+ timeout => 1,
+ }, $class);
+ } else {
+ $proc= check_any();
+ }
+ } while (! $proc);
+
+ return $proc;
+}
+
+
+#
+# Wait for all processes to exit
+#
+sub wait_all {
+ while(keys %running)
+ {
+ wait_any();
+ }
+}
+
+#
+# Set global flag to tell all safe_process to exit after starting child
+#
+
+sub start_exit {
+ $start_exit= 1;
+}
+
+#
+# Check if any process has exited, but don't wait.
+#
+# Returns a reference to the SafeProcess that
+# exited or undefined
+#
+sub check_any {
+ for my $proc (values %running){
+ if ( $proc->is_child($$) ) {
+ if (not $proc->wait_one(0)) {
+ _verbose ("Found exited $proc");
+ return $proc;
+ }
+ }
+ }
+ return undef;
+}
+
+
+# Overload string operator
+# and fallback to default functions if no
+# overloaded function is found
+#
+use overload
+ '""' => \&self2str,
+ fallback => 1;
+
+
+#
+# Return the process as a nicely formatted string
+#
+sub self2str {
+ my ($self)= @_;
+ my $pid= $self->{SAFE_PID};
+ my $winpid= $self->{SAFE_WINPID};
+ my $name= $self->{SAFE_NAME};
+ my $exit_status= $self->{EXIT_STATUS};
+
+ my $str= "[$name - pid: $pid";
+ $str.= ", winpid: $winpid" if defined $winpid;
+ $str.= ", exit: $exit_status" if defined $exit_status;
+ $str.= "]";
+}
+
+sub _verbose {
+ return unless $_verbose;
+ print STDERR " ## @_\n";
+}
+
+
+sub pid {
+ my ($self)= @_;
+ return $self->{SAFE_PID};
+}
+
+sub user_data {
+ my ($self)= @_;
+ return $self->{SAFE_USER_DATA};
+}
+
+
+1;
diff --git a/mysql-test/lib/My/SafeProcess/Base.pm b/mysql-test/lib/My/SafeProcess/Base.pm
new file mode 100644
index 00000000..1cd01cb0
--- /dev/null
+++ b/mysql-test/lib/My/SafeProcess/Base.pm
@@ -0,0 +1,227 @@
+# -*- cperl -*-
+# Copyright (c) 2007 MySQL AB, 2008, 2009 Sun Microsystems, Inc.
+# Use is subject to license terms.
+#
+# 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-1335 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;
+
+package My::SafeProcess::Base;
+
+#
+# Utility functions for Process management
+#
+
+use Carp;
+use IO::Pipe;
+
+use base qw(Exporter);
+our @EXPORT= qw(create_process);
+
+
+
+#
+# safe_fork
+# Retry a couple of times if fork returns EAGAIN
+#
+sub _safe_fork {
+ my $retries= 100;
+ my $pid;
+
+ FORK:
+ {
+ $pid= fork;
+ if ( not defined($pid)) {
+
+ croak("fork failed after: $!") if (!$retries--);
+
+ warn("fork failed sleep 1 second and redo: $!");
+ sleep(1);
+ redo FORK;
+ }
+ }
+
+ return $pid;
+};
+
+
+#
+# Decode exit status
+#
+sub exit_status {
+ my $self= shift;
+ my $raw= $self->{EXIT_STATUS};
+
+ croak("Can't call exit_status before process has died")
+ unless defined $raw;
+
+ if ($raw & 127)
+ {
+ # Killed by signal
+ my $signal_num= $raw & 127;
+ my $dumped_core= $raw & 128;
+ return 1; # Return error code
+ }
+ else
+ {
+ # Normal process exit
+ return $raw >> 8;
+ };
+}
+
+# threads.pm may not exist everywhere, so use only on Windows.
+
+use if $^O eq "MSWin32", "threads";
+use if $^O eq "MSWin32", "threads::shared";
+
+my $win32_spawn_lock :shared;
+
+
+#
+# Create a new process
+# Return pid of the new process
+#
+sub create_process {
+ my %opts=
+ (
+ @_
+ );
+
+ my $path = delete($opts{'path'}) or die "path required";
+ my $args = delete($opts{'args'}) or die "args required";
+ my $input = delete($opts{'input'});
+ my $output = delete($opts{'output'});
+ my $error = delete($opts{'error'});
+
+ my $open_mode= $opts{append} ? ">>" : ">";
+
+ if ($^O eq "MSWin32"){
+
+ lock($win32_spawn_lock);
+
+ #printf STDERR "stdin %d, stdout %d, stderr %d\n",
+ # fileno STDIN, fileno STDOUT, fileno STDERR;
+
+ # input output redirect
+ my ($oldin, $oldout, $olderr);
+ open $oldin, '<&', \*STDIN or die "Failed to save old stdin: $!";
+ open $oldout, '>&', \*STDOUT or die "Failed to save old stdout: $!";
+ open $olderr, '>&', \*STDERR or die "Failed to save old stderr: $!";
+
+ if ( $input ) {
+ if ( ! open(STDIN, "<", $input) ) {
+ croak("can't redirect STDIN to '$input': $!");
+ }
+ }
+
+ if ( $output ) {
+ if ( ! open(STDOUT, $open_mode, $output) ) {
+ croak("can't redirect STDOUT to '$output': $!");
+ }
+ }
+
+ if ( $error ) {
+ if ( $output eq $error ) {
+ if ( ! open(STDERR, ">&STDOUT") ) {
+ croak("can't dup STDOUT: $!");
+ }
+ }
+ elsif ( ! open(STDERR, $open_mode, $error) ) {
+ croak("can't redirect STDERR to '$error': $!");
+ }
+ }
+
+
+ # Magic use of 'system(1, @args)' to spawn a process
+ # and get a proper Win32 pid
+ unshift (@$args, $path);
+ my $pid= system(1, @$args);
+ if ( $pid == 0 ){
+ print $olderr "create_process failed: $^E\n";
+ die "create_process failed: $^E";
+ }
+
+ # Retore IO redirects
+ open STDERR, '>&', $olderr
+ or croak("unable to reestablish STDERR");
+ open STDOUT, '>&', $oldout
+ or croak("unable to reestablish STDOUT");
+ open STDIN, '<&', $oldin
+ or croak("unable to reestablish STDIN");
+ #printf STDERR "stdin %d, stdout %d, stderr %d\n",
+ # fileno STDIN, fileno STDOUT, fileno STDERR;
+ return $pid;
+
+ }
+
+ local $SIG{PIPE}= sub { print STDERR "Got signal $@\n"; };
+ my $pipe= IO::Pipe->new();
+ my $pid= _safe_fork();
+ if ($pid){
+ # Parent
+ $pipe->reader();
+ my $line= <$pipe>; # Wait for child to say it's ready
+ return $pid;
+ }
+
+ $SIG{INT}= 'DEFAULT';
+ $SIG{HUP}= 'DEFAULT';
+
+ # Make this process it's own process group to be able to kill
+ # it and any childs(that hasn't changed group themself)
+ setpgrp(0,0) if $opts{setpgrp};
+
+ if ( $output ) {
+ close STDOUT;
+ open(STDOUT, $open_mode, $output)
+ or croak "can't redirect STDOUT to '$output': $!";
+ }
+
+ if ( $error ) {
+ if ( defined $output and $output eq $error ) {
+ if ( ! open(STDERR, ">&STDOUT") ) {
+ croak("can't dup STDOUT: $!");
+ }
+ }
+ else {
+ close STDERR;
+ open(STDERR, $open_mode, $error)
+ or croak "can't redirect STDERR to '$error': $!";
+ }
+ }
+
+ if ( $input ) {
+ if ( ! open(STDIN, "<", $input) ) {
+ croak("can't redirect STDIN to '$input': $!");
+ }
+ }
+
+ # Tell parent to continue
+ $pipe->writer();
+ print $pipe "ready\n";
+
+ if ( !exec($path, @$args) ){
+ croak("Failed to exec '$path': $!");
+ }
+
+ croak("Should never come here");
+
+}
+
+1;
+
diff --git a/mysql-test/lib/My/SafeProcess/CMakeLists.txt b/mysql-test/lib/My/SafeProcess/CMakeLists.txt
new file mode 100644
index 00000000..0004a449
--- /dev/null
+++ b/mysql-test/lib/My/SafeProcess/CMakeLists.txt
@@ -0,0 +1,50 @@
+# Copyright (c) 2006, 2013, 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-1335 USA
+
+
+INCLUDE_DIRECTORIES(${CMAKE_SOURCE_DIR}/include)
+
+IF (WIN32)
+ ADD_EXECUTABLE(my_safe_process safe_process_win.cc)
+ ADD_EXECUTABLE(my_safe_kill safe_kill_win.cc)
+ TARGET_INCLUDE_DIRECTORIES(my_safe_kill PRIVATE ${CMAKE_SOURCE_DIR}/include)
+ TARGET_LINK_LIBRARIES(my_safe_kill mysys psapi)
+ELSE()
+ ADD_EXECUTABLE(my_safe_process safe_process.cc)
+ENDIF()
+
+IF(WITH_WSREP)
+ ADD_EXECUTABLE(wsrep_check_version wsrep_check_version.c)
+ TARGET_LINK_LIBRARIES(wsrep_check_version ${CMAKE_DL_LIBS})
+ENDIF()
+
+IF(NOT INSTALL_MYSQLTESTDIR)
+ RETURN()
+ENDIF()
+
+SET(INSTALL_ARGS
+ DESTINATION "${INSTALL_MYSQLTESTDIR}/lib/My/SafeProcess"
+ COMPONENT Test
+)
+
+INSTALL(TARGETS my_safe_process ${INSTALL_ARGS})
+IF(WITH_WSREP)
+ INSTALL(TARGETS wsrep_check_version ${INSTALL_ARGS})
+ENDIF()
+IF (WIN32)
+ INSTALL(TARGETS my_safe_kill ${INSTALL_ARGS})
+ENDIF()
+
+INSTALL(FILES Base.pm ${INSTALL_ARGS})
diff --git a/mysql-test/lib/My/SafeProcess/safe_kill_win.cc b/mysql-test/lib/My/SafeProcess/safe_kill_win.cc
new file mode 100644
index 00000000..375ed80b
--- /dev/null
+++ b/mysql-test/lib/My/SafeProcess/safe_kill_win.cc
@@ -0,0 +1,146 @@
+/* Copyright (c) 2007, 2010, 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-1335 USA */
+
+
+/*
+ Utility program used to signal a safe_process it's time to shutdown
+
+ Usage:
+ safe_kill <pid>
+*/
+
+#include <windows.h>
+#include <stdio.h>
+#include <signal.h>
+#include <stdlib.h>
+#include <psapi.h>
+#include <my_minidump.h>
+
+#include <tlhelp32.h>
+#include <vector>
+
+
+static std::vector<DWORD> find_children(DWORD pid)
+{
+ HANDLE h= NULL;
+ PROCESSENTRY32 pe={ 0 };
+ std::vector<DWORD> children;
+
+ pe.dwSize = sizeof(PROCESSENTRY32);
+ h = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
+ if(h == INVALID_HANDLE_VALUE)
+ return children;
+
+ for (BOOL ret = Process32First(h, &pe); ret; ret = Process32Next(h, &pe))
+ {
+ if (pe.th32ParentProcessID == pid)
+ children.push_back(pe.th32ProcessID);
+ }
+ CloseHandle(h);
+ return children;
+}
+
+
+static int create_dump(DWORD pid, int recursion_depth= 5)
+{
+ if (recursion_depth < 0)
+ return 0;
+
+ my_create_minidump(pid, TRUE);
+ std::vector<DWORD> children= find_children(pid);
+ for(size_t i=0; i < children.size(); i++)
+ create_dump(children[i], recursion_depth -1);
+ return 0;
+}
+
+
+int main(int argc, const char** argv )
+{
+ DWORD pid= -1;
+ HANDLE shutdown_event;
+ char safe_process_name[32]= {0};
+ int retry_open_event= 2;
+ /* Ignore any signals */
+ signal(SIGINT, SIG_IGN);
+ signal(SIGBREAK, SIG_IGN);
+ signal(SIGTERM, SIG_IGN);
+
+ if ((argc != 2 && argc != 3) || (argc == 3 && strcmp(argv[2],"dump"))) {
+ fprintf(stderr, "safe_kill <pid> [dump]\n");
+ exit(2);
+ }
+ pid= atoi(argv[1]);
+
+ if (argc == 3)
+ {
+ return create_dump(pid);
+ }
+ _snprintf(safe_process_name, sizeof(safe_process_name),
+ "safe_process[%d]", pid);
+
+ /* Open the event to signal */
+ while ((shutdown_event=
+ OpenEvent(EVENT_MODIFY_STATE, FALSE, safe_process_name)) == NULL)
+ {
+ /*
+ Check if the process is alive, otherwise there is really
+ no sense to retry the open of the event
+ */
+ HANDLE process;
+ DWORD exit_code;
+ process= OpenProcess(SYNCHRONIZE| PROCESS_QUERY_INFORMATION, FALSE, pid);
+ if (!process)
+ {
+ /* Already died */
+ exit(1);
+ }
+
+ if (!GetExitCodeProcess(process,&exit_code))
+ {
+ fprintf(stderr, "GetExitCodeProcess failed, pid= %lu, err= %lu\n",
+ pid, GetLastError());
+ exit(1);
+ }
+
+ if (exit_code != STILL_ACTIVE)
+ {
+ /* Already died */
+ CloseHandle(process);
+ exit(2);
+ }
+
+ CloseHandle(process);
+
+ if (retry_open_event--)
+ Sleep(100);
+ else
+ {
+ fprintf(stderr, "Failed to open shutdown_event '%s', error: %lu\n",
+ safe_process_name, GetLastError());
+ exit(3);
+ }
+ }
+
+ if(SetEvent(shutdown_event) == 0)
+ {
+ fprintf(stderr, "Failed to signal shutdown_event '%s', error: %lu\n",
+ safe_process_name, GetLastError());
+ CloseHandle(shutdown_event);
+ exit(4);
+ }
+ CloseHandle(shutdown_event);
+ exit(0);
+}
+
diff --git a/mysql-test/lib/My/SafeProcess/safe_process.cc b/mysql-test/lib/My/SafeProcess/safe_process.cc
new file mode 100644
index 00000000..dcf9491d
--- /dev/null
+++ b/mysql-test/lib/My/SafeProcess/safe_process.cc
@@ -0,0 +1,364 @@
+/* Copyright (c) 2008, 2012, Oracle and/or its affiliates
+ Copyright (c) 2019, MariaDB Corporation.
+
+ 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 Street, Fifth Floor, Boston, MA 02110-1335 USA */
+
+
+/*
+ Utility program that encapsulates process creation, monitoring
+ and bulletproof process cleanup
+
+ Usage:
+ safe_process [options to safe_process] -- progname arg1 ... argn
+
+ To safeguard mysqld you would invoke safe_process with a few options
+ for safe_process itself followed by a double dash to indicate start
+ of the command line for the program you really want to start
+
+ $> safe_process --output=output.log -- mysqld --datadir=var/data1 ...
+
+ This would redirect output to output.log and then start mysqld,
+ once it has done that it will continue to monitor the child as well
+ as the parent.
+
+ The safe_process then checks the follwing things:
+ 1. Child exits, propagate the childs return code to the parent
+ by exiting with the same return code as the child.
+
+ 2. Parent dies, immediately kill the child and exit, thus the
+ parent does not need to properly cleanup any child, it is handled
+ automatically.
+
+ 3. Signal's recieced by the process will trigger same action as 2)
+
+*/
+
+#include <sys/types.h>
+#include <sys/wait.h>
+#include <sys/time.h>
+#include <sys/resource.h>
+#include <unistd.h>
+#include <stdarg.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <signal.h>
+#include <string.h>
+#include <errno.h>
+
+int verbose= 0;
+int terminated= 0;
+pid_t child_pid= -1;
+char safe_process_name[32]= {0};
+
+
+static void message(const char* fmt, ...)
+{
+ if (!verbose)
+ return;
+ va_list args;
+ fprintf(stderr, "%s: ", safe_process_name);
+ va_start(args, fmt);
+ vfprintf(stderr, fmt, args);
+ fprintf(stderr, "\n");
+ va_end(args);
+ fflush(stderr);
+}
+
+
+static void die(const char* fmt, ...)
+{
+ va_list args;
+ fprintf(stderr, "%s: FATAL ERROR, ", safe_process_name);
+ va_start(args, fmt);
+ vfprintf(stderr, fmt, args);
+ fprintf(stderr, "\n");
+ va_end(args);
+ if (int last_err= errno)
+ fprintf(stderr, "error: %d, %s\n", last_err, strerror(last_err));
+ exit(6);
+}
+
+
+#ifdef __APPLE__
+#include <sys/sysctl.h>
+
+
+/*
+ Eventually we may want to adopt kern.corefile parsing code from
+ https://opensource.apple.com/source/xnu/xnu-3247.1.106/bsd/kern/kern_proc.c
+*/
+
+void handle_core(pid_t pid)
+{
+ char corefile[256];
+ int coredump;
+ size_t corefile_size= sizeof(corefile);
+ size_t coredump_size= sizeof(coredump);
+
+ if (sysctlbyname("kern.coredump", &coredump, &coredump_size, 0, 0) ||
+ sysctlbyname("kern.corefile", corefile, &corefile_size, 0, 0))
+ {
+ message("sysctlbyname failed: %d (%s)", errno, strerror(errno));
+ return;
+ }
+
+ if (!coredump)
+ {
+ message("core dumps disabled, to enable run sudo sysctl kern.coredump=1");
+ return;
+ }
+
+ if (!strncmp(corefile, "/cores/core.%P", corefile_size))
+ {
+ char from[256];
+ char *to= from + 7;
+
+ snprintf(from, sizeof(from), "/cores/core.%u", pid);
+ if (!access(from, R_OK))
+ {
+ if (symlink(from, to))
+ message("symlink failed: %d (%s)", errno, strerror(errno));
+ }
+ }
+}
+#else
+void handle_core(pid_t pid __attribute__((unused))) {}
+#endif
+
+
+static int kill_child(bool was_killed)
+{
+ int status= 0;
+ pid_t ret_pid= 0;
+
+ message("Killing child: %d", child_pid);
+ // Terminate whole process group
+ if (! was_killed)
+ {
+ kill(-child_pid, SIGTERM);
+ sleep(10); // will be interrupted by SIGCHLD
+ if (!(ret_pid= waitpid(child_pid, &status, WNOHANG)))
+ kill(-child_pid, SIGKILL);
+ }
+
+ if (!ret_pid)
+ ret_pid= waitpid(child_pid, &status, 0);
+ if (ret_pid == child_pid)
+ {
+ int exit_code= 1;
+ if (WIFEXITED(status))
+ {
+ // Process has exited, collect return status
+ exit_code= WEXITSTATUS(status);
+ message("Child exit: %d", exit_code);
+ // Exit with exit status of the child
+ return exit_code;
+ }
+
+ if (WIFSIGNALED(status))
+ {
+ message("Child killed by signal: %d", WTERMSIG(status));
+ handle_core(child_pid);
+ }
+
+ return exit_code;
+ }
+ return 5;
+}
+
+
+extern "C" void handle_abort(int sig)
+{
+ message("Got signal %d, child_pid: %d, sending ABRT", sig, child_pid);
+
+ if (child_pid > 0) {
+ kill(-child_pid, SIGABRT); // Don't wait for it to terminate
+ }
+}
+
+
+extern "C" void handle_signal(int sig)
+{
+ message("Got signal %d, child_pid: %d", sig, child_pid);
+ terminated= 1;
+
+ if (child_pid > 0)
+ _exit(kill_child(sig == SIGCHLD));
+
+ // Ignore further signals
+ signal(SIGTERM, SIG_IGN);
+ signal(SIGINT, SIG_IGN);
+ signal(SIGHUP, SIG_IGN);
+
+ // Continune execution, allow the child to be started and
+ // finally terminated by monitor loop
+}
+
+
+void setlimit(int what, uint soft, uint hard)
+{
+ struct rlimit lim = { soft, hard };
+ if (setrlimit (what, &lim) < 0)
+ message("setrlimit failed, errno=%d", errno);
+}
+
+
+int main(int argc, char* const argv[] )
+{
+ char* const* child_argv= 0;
+ pid_t own_pid= getpid();
+ pid_t parent_pid= getppid();
+ bool nocore = false;
+ struct sigaction sa,sa_abort;
+
+ sa.sa_handler= handle_signal;
+ sa.sa_flags= SA_NOCLDSTOP;
+ sigemptyset(&sa.sa_mask);
+
+ sa_abort.sa_handler= handle_abort;
+ sa_abort.sa_flags= 0;
+ sigemptyset(&sa_abort.sa_mask);
+ /* Install signal handlers */
+ sigaction(SIGTERM, &sa,NULL);
+ sigaction(SIGINT, &sa,NULL);
+ sigaction(SIGHUP, &sa, NULL);
+ sigaction(SIGCHLD, &sa,NULL);
+ sigaction(SIGABRT, &sa_abort,NULL);
+
+ sprintf(safe_process_name, "safe_process[%ld]", (long) own_pid);
+
+ message("Started");
+
+ /* Parse arguments */
+ for (int i= 1; i < argc; i++) {
+ const char* arg= argv[i];
+ if (strcmp(arg, "--") == 0 && strlen(arg) == 2) {
+ /* Got the "--" delimiter */
+ if (i >= argc)
+ die("No real args -> nothing to do");
+ child_argv= &argv[i+1];
+ break;
+ } else {
+ if ( strcmp(arg, "--verbose") == 0 )
+ verbose++;
+ else if ( strncmp(arg, "--parent-pid", 12) == 0 )
+ {
+ /* Override parent_pid with a value provided by user */
+ const char* start;
+ if ((start= strstr(arg, "=")) == NULL)
+ die("Could not find start of option value in '%s'", arg);
+ start++; /* Step past = */
+ if ((parent_pid= atoi(start)) == 0)
+ die("Invalid value '%s' passed to --parent-id", start);
+ }
+ else if ( strcmp(arg, "--nocore") == 0 )
+ {
+ nocore = true; // Don't allow the process to dump core
+ }
+ else if ( strncmp (arg, "--env ", 6) == 0 )
+ {
+ putenv(strdup(arg+6));
+ }
+ else
+ die("Unknown option: %s", arg);
+ }
+ }
+ if (!child_argv || *child_argv == 0)
+ die("nothing to do");
+
+ message("parent_pid: %d", parent_pid);
+ if (parent_pid == own_pid)
+ die("parent_pid is equal to own pid!");
+
+ char buf;
+ int pfd[2];
+ if (pipe(pfd) == -1)
+ die("Failed to create pipe");
+
+ /* Create the child process */
+ while((child_pid= fork()) == -1)
+ {
+ message("fork failed");
+ sleep(1);
+ }
+
+ /*
+ Child: Make this process it's own process group to be able to kill
+ it and any its children that hasn't changed a group themselves)
+
+ Parent: Detach from the parent's process group, so that killing a parent
+ group wouldn't kill us (if we're killed, there's no one to kill our child
+ processes that run in their own process group). There's a loop below
+ that monitors the parent, it's enough.
+ */
+ setpgid(0, 0);
+
+
+ if (child_pid == 0)
+ {
+ close(pfd[0]); // Close unused read end
+
+ // Use default signal handlers in child
+ signal(SIGTERM, SIG_DFL);
+ signal(SIGINT, SIG_DFL);
+ signal(SIGHUP, SIG_DFL);
+ signal(SIGCHLD, SIG_DFL);
+
+ if (nocore)
+ setlimit(RLIMIT_CORE, 0, 0);
+
+ /*
+ mysqld defaults depend on that. make test results stable and independent
+ from the environment
+ */
+ setlimit(RLIMIT_NOFILE, 1024, 1024);
+
+ // Signal that child is ready
+ buf= 37;
+ if ((write(pfd[1], &buf, 1)) < 1)
+ die("Failed to signal that child is ready");
+ // Close write end
+ close(pfd[1]);
+
+ execvp(child_argv[0], child_argv);
+ die("Failed to exec child");
+ }
+
+ close(pfd[1]); // Close unused write end
+
+ // Wait for child to signal it's ready
+ if ((read(pfd[0], &buf, 1)) < 1)
+ die("Failed to read signal from child");
+
+ if (buf != 37)
+ die("Didn't get 37 from pipe");
+ close(pfd[0]); // Close read end
+
+ /* Monitor loop */
+ message("Started child %d, terminated: %d", child_pid, terminated);
+
+ while (!terminated)
+ {
+ // Check if parent is still alive
+ if (kill(parent_pid, 0) != 0)
+ {
+ message("Parent is not alive anymore");
+ break;
+ }
+ /* Wait for parent or child to die */
+ sleep(1);
+ }
+ return kill_child(0);
+}
+
diff --git a/mysql-test/lib/My/SafeProcess/safe_process_win.cc b/mysql-test/lib/My/SafeProcess/safe_process_win.cc
new file mode 100644
index 00000000..8a5bb60a
--- /dev/null
+++ b/mysql-test/lib/My/SafeProcess/safe_process_win.cc
@@ -0,0 +1,389 @@
+/* Copyright (c) 2007, 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-1335 USA */
+
+
+/*
+ Utility program that encapsulates process creation, monitoring
+ and bulletproof process cleanup
+
+ Usage:
+ safe_process [options to safe_process] -- progname arg1 ... argn
+
+ To safeguard mysqld you would invoke safe_process with a few options
+ for safe_process itself followed by a double dash to indicate start
+ of the command line for the program you really want to start
+
+ $> safe_process --output=output.log -- mysqld --datadir=var/data1 ...
+
+ This would redirect output to output.log and then start mysqld,
+ once it has done that it will continue to monitor the child as well
+ as the parent.
+
+ The safe_process then checks the follwing things:
+ 1. Child exits, propagate the childs return code to the parent
+ by exiting with the same return code as the child.
+
+ 2. Parent dies, immediately kill the child and exit, thus the
+ parent does not need to properly cleanup any child, it is handled
+ automatically.
+
+ 3. Signal's recieced by the process will trigger same action as 2)
+
+ 4. The named event "safe_process[pid]" can be signaled and will
+ trigger same action as 2)
+
+ WARNING! Be careful when using ProcessExplorer, since it will open
+ a handle to each process(and maybe also the Job), the process
+ spawned by safe_process will not be closed off when safe_process
+ is killed.
+*/
+
+#include <windows.h>
+#include <stdio.h>
+#include <tlhelp32.h>
+#include <signal.h>
+#include <stdlib.h>
+
+static int verbose= 0;
+static char safe_process_name[32]= {0};
+
+static void message(const char* fmt, ...)
+{
+ if (!verbose)
+ return;
+ va_list args;
+ fprintf(stderr, "%s: ", safe_process_name);
+ va_start(args, fmt);
+ vfprintf(stderr, fmt, args);
+ fprintf(stderr, "\n");
+ va_end(args);
+ fflush(stderr);
+}
+
+
+static void die(const char* fmt, ...)
+{
+ int last_err= GetLastError();
+ va_list args;
+ fprintf(stderr, "%s: FATAL ERROR, ", safe_process_name);
+ va_start(args, fmt);
+ vfprintf(stderr, fmt, args);
+ fprintf(stderr, "\n");
+ va_end(args);
+ if (last_err)
+ {
+ char *message_text;
+ if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER
+ |FORMAT_MESSAGE_IGNORE_INSERTS, NULL, last_err , 0, (LPSTR)&message_text,
+ 0, NULL))
+ {
+ fprintf(stderr,"error: %d, %s\n",last_err, message_text);
+ LocalFree(message_text);
+ }
+ else
+ {
+ /* FormatMessage failed, print error code only */
+ fprintf(stderr,"error:%d\n", last_err);
+ }
+ }
+ fflush(stderr);
+ exit(1);
+}
+
+
+DWORD get_parent_pid(DWORD pid)
+{
+ HANDLE snapshot;
+ DWORD parent_pid= 0;
+ PROCESSENTRY32 pe32;
+ pe32.dwSize= sizeof(PROCESSENTRY32);
+
+ snapshot= CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
+ if (snapshot == INVALID_HANDLE_VALUE)
+ die("CreateToolhelp32Snapshot failed");
+
+ if (!Process32First(snapshot, &pe32))
+ {
+ CloseHandle(snapshot);
+ die("Process32First failed");
+ }
+
+ do
+ {
+ if (pe32.th32ProcessID == pid)
+ parent_pid= pe32.th32ParentProcessID;
+ } while(Process32Next( snapshot, &pe32));
+ CloseHandle(snapshot);
+
+ if (parent_pid == 0)
+ die("Could not find parent pid");
+
+ return parent_pid;
+}
+
+
+enum {
+ PARENT,
+ CHILD,
+ EVENT,
+ NUM_HANDLES
+};
+
+
+HANDLE shutdown_event;
+void handle_signal (int signal)
+{
+ message("Got signal: %d", signal);
+ if(SetEvent(shutdown_event) == 0) {
+ /* exit safe_process and (hopefully) kill off the child */
+ die("Failed to SetEvent");
+ }
+}
+
+
+int main(int argc, const char** argv )
+{
+ char child_args[4096]= {0};
+ DWORD pid= GetCurrentProcessId();
+ DWORD parent_pid= get_parent_pid(pid);
+ HANDLE job_handle;
+ HANDLE wait_handles[NUM_HANDLES]= {0};
+ PROCESS_INFORMATION process_info= {0};
+ BOOL nocore= FALSE;
+
+ sprintf(safe_process_name, "safe_process[%lu]", pid);
+
+ /* Create an event for the signal handler */
+ if ((shutdown_event=
+ CreateEvent(NULL, TRUE, FALSE, safe_process_name)) == NULL)
+ die("Failed to create shutdown_event");
+ wait_handles[EVENT]= shutdown_event;
+
+ signal(SIGINT, handle_signal);
+ signal(SIGBREAK, handle_signal);
+ signal(SIGTERM, handle_signal);
+
+ message("Started");
+
+ /* Parse arguments */
+ for (int i= 1; i < argc; i++) {
+ const char* arg= argv[i];
+ char* to= child_args;
+ if (strcmp(arg, "--") == 0 && strlen(arg) == 2) {
+ /* Got the "--" delimiter */
+ if (i >= argc)
+ die("No real args -> nothing to do");
+ /* Copy the remaining args to child_arg */
+ for (int j= i+1; j < argc; j++) {
+ arg= argv[j];
+ if (strchr (arg, ' ') &&
+ arg[0] != '\"' &&
+ arg[strlen(arg)] != '\"')
+ {
+ /* Quote arg that contains spaces and are not quoted already */
+ to+= _snprintf(to, child_args + sizeof(child_args) - to,
+ "\"%s\" ", arg);
+ }
+ else
+ {
+ to+= _snprintf(to, child_args + sizeof(child_args) - to,
+ "%s ", arg);
+ }
+ }
+ break;
+ } else {
+ if (strcmp(arg, "--verbose") == 0)
+ verbose++;
+ else if (strncmp(arg, "--parent-pid", 12) == 0)
+ {
+ /* Override parent_pid with a value provided by user */
+ const char* start;
+ if ((start= strstr(arg, "=")) == NULL)
+ die("Could not find start of option value in '%s'", arg);
+ start++; /* Step past = */
+ if ((parent_pid= atoi(start)) == 0)
+ die("Invalid value '%s' passed to --parent-id", start);
+ }
+ else if (strcmp(arg, "--nocore") == 0)
+ {
+ nocore= TRUE;
+ }
+ else if ( strncmp (arg, "--env ", 6) == 0 )
+ {
+ putenv(strdup(arg+6));
+ }
+ else
+ die("Unknown option: %s", arg);
+ }
+ }
+ if (*child_args == '\0')
+ die("nothing to do");
+
+ /* Open a handle to the parent process */
+ message("parent_pid: %d", parent_pid);
+ if (parent_pid == pid)
+ die("parent_pid is equal to own pid!");
+
+ if ((wait_handles[PARENT]=
+ OpenProcess(SYNCHRONIZE, FALSE, parent_pid)) == NULL)
+ die("Failed to open parent process with pid: %d", parent_pid);
+
+ /* Create the child process in a job */
+ JOBOBJECT_EXTENDED_LIMIT_INFORMATION jeli = { 0 };
+ STARTUPINFO si = { 0 };
+ si.cb = sizeof(si);
+
+ /*
+ Create the job object to make it possible to kill the process
+ and all of it's children in one go
+ */
+ if ((job_handle= CreateJobObject(NULL, NULL)) == NULL)
+ die("CreateJobObject failed");
+
+ /*
+ Make all processes associated with the job terminate when the
+ last handle to the job is closed.
+ */
+#ifndef JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE
+#define JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE 0x00002000
+#endif
+
+ jeli.BasicLimitInformation.LimitFlags = JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE;
+ if (SetInformationJobObject(job_handle, JobObjectExtendedLimitInformation,
+ &jeli, sizeof(jeli)) == 0)
+ message("SetInformationJobObject failed, continue anyway...");
+
+ /* Avoid popup box */
+ if (nocore)
+ SetErrorMode(SEM_FAILCRITICALERRORS | SEM_NOGPFAULTERRORBOX
+ | SEM_NOOPENFILEERRORBOX);
+
+#if 0
+ /* Setup stdin, stdout and stderr redirect */
+ si.dwFlags= STARTF_USESTDHANDLES;
+ si.hStdInput= GetStdHandle(STD_INPUT_HANDLE);
+ si.hStdOutput= GetStdHandle(STD_OUTPUT_HANDLE);
+ si.hStdError= GetStdHandle(STD_ERROR_HANDLE);
+#endif
+
+ /*
+ Create the process suspended to make sure it's assigned to the
+ Job before it creates any process of it's own
+
+ Allow the new process to break away from any job that this
+ process is part of so that it can be assigned to the new JobObject
+ we just created. This is safe since the new JobObject is created with
+ the JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE flag, making sure it will be
+ terminated when the last handle to it is closed(which is owned by
+ this process).
+
+ If breakaway from job fails on some reason, fallback is to create a
+ new process group. Process groups also allow to kill process and its
+ descedants, subject to some restrictions (processes have to run within
+ the same console,and must not ignore CTRL_BREAK)
+ */
+ DWORD create_flags[]= {CREATE_BREAKAWAY_FROM_JOB, CREATE_NEW_PROCESS_GROUP, 0};
+ BOOL process_created= FALSE;
+ BOOL jobobject_assigned= FALSE;
+
+ for (size_t i=0; i < sizeof(create_flags)/sizeof(create_flags[0]); i++)
+ {
+ process_created= CreateProcess(NULL, (LPSTR)child_args,
+ NULL,
+ NULL,
+ TRUE, /* inherit handles */
+ CREATE_SUSPENDED | create_flags[i],
+ NULL,
+ NULL,
+ &si,
+ &process_info);
+ if (process_created)
+ {
+ jobobject_assigned= AssignProcessToJobObject(job_handle, process_info.hProcess);
+ break;
+ }
+ }
+
+ if (!process_created)
+ {
+ die("CreateProcess failed");
+ }
+ ResumeThread(process_info.hThread);
+ CloseHandle(process_info.hThread);
+
+ wait_handles[CHILD]= process_info.hProcess;
+
+ message("Started child %d", process_info.dwProcessId);
+
+ /* Monitor loop */
+ DWORD child_exit_code= 1;
+ DWORD wait_res= WaitForMultipleObjects(NUM_HANDLES, wait_handles,
+ FALSE, INFINITE);
+ switch (wait_res)
+ {
+ case WAIT_OBJECT_0 + PARENT:
+ message("Parent exit");
+ break;
+ case WAIT_OBJECT_0 + CHILD:
+ if (GetExitCodeProcess(wait_handles[CHILD], &child_exit_code) == 0)
+ message("Child exit: could not get exit_code");
+ else
+ message("Child exit: exit_code: %d", child_exit_code);
+ break;
+ case WAIT_OBJECT_0 + EVENT:
+ message("Wake up from shutdown_event");
+ break;
+
+ default:
+ message("Unexpected result %d from WaitForMultipleObjects", wait_res);
+ break;
+ }
+ message("Exiting, child: %d", process_info.dwProcessId);
+
+ if (TerminateJobObject(job_handle, 201) == 0)
+ message("TerminateJobObject failed");
+ CloseHandle(job_handle);
+ message("Job terminated and closed");
+
+
+
+ if (wait_res != WAIT_OBJECT_0 + CHILD)
+ {
+ if (!jobobject_assigned)
+ {
+ TerminateProcess(process_info.hProcess, 202);
+ }
+ /* The child has not yet returned, wait for it */
+ message("waiting for child to exit");
+ if ((wait_res= WaitForSingleObject(wait_handles[CHILD], INFINITE))
+ != WAIT_OBJECT_0)
+ {
+ message("child wait failed: %d", wait_res);
+ }
+ else
+ {
+ message("child wait succeeded");
+ }
+ /* Child's exit code should now be 201, no need to get it */
+ }
+
+ message("Closing handles");
+ for (int i= 0; i < NUM_HANDLES; i++)
+ CloseHandle(wait_handles[i]);
+
+ message("Exiting, exit_code: %d", child_exit_code);
+ exit(child_exit_code);
+}
+
diff --git a/mysql-test/lib/My/SafeProcess/wsrep_check_version.c b/mysql-test/lib/My/SafeProcess/wsrep_check_version.c
new file mode 100644
index 00000000..7398bc8a
--- /dev/null
+++ b/mysql-test/lib/My/SafeProcess/wsrep_check_version.c
@@ -0,0 +1,51 @@
+/*
+ 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 Street, Fifth Floor, Boston, MA 02111-1301 USA
+ */
+
+#include <my_global.h>
+#include <string.h>
+#include "../../../../wsrep-lib/wsrep-API/v26/wsrep_api.h"
+
+int main(int argc, char **argv)
+{
+ int rc= 1;
+ void *dlh;
+ const char *provider= getenv("WSREP_PROVIDER");
+ char** dlversion= NULL;
+
+ if (!provider || !*provider)
+ {
+ printf("WSREP_PROVIDER is not set\n");
+ return 1;
+ }
+ if (!(dlh= dlopen(provider, RTLD_NOW | RTLD_LOCAL)))
+ {
+ printf("Can't open WSREP_PROVIDER (%s) library, error: %s\n",
+ provider, dlerror());
+ return 1;
+ }
+
+ dlversion= (char**) dlsym(dlh, "wsrep_interface_version");
+ if (dlversion && *dlversion)
+ {
+ rc= strcmp(*dlversion, WSREP_INTERFACE_VERSION) ? 2 : 0;
+ if (rc)
+ printf("Wrong wsrep provider library version, found: %s, need: %s\n", *dlversion, WSREP_INTERFACE_VERSION);
+ }
+ else
+ printf("Galera library does not contain a version symbol");
+
+ dlclose(dlh);
+ return rc;
+}
diff --git a/mysql-test/lib/My/Suite.pm b/mysql-test/lib/My/Suite.pm
new file mode 100644
index 00000000..a603008f
--- /dev/null
+++ b/mysql-test/lib/My/Suite.pm
@@ -0,0 +1,27 @@
+# A default suite class that is used for all suites without their owns suite.pm
+# see README.suites for a description
+
+package My::Suite;
+
+sub is_default { 0 }
+sub config_files { () }
+sub servers { () }
+sub skip_combinations { () }
+
+sub new { bless { } }
+
+sub list_cases {
+ my ($self, $testdir) = @_;
+ opendir(TESTDIR, $testdir) or return ();
+ my (@cases) = grep { s/\.test$// } readdir TESTDIR;
+ closedir TESTDIR;
+ @cases;
+}
+
+sub start_test {
+ my ($self, $tinfo)= @_;
+ &::start_mysqltest($tinfo);
+}
+
+bless { };
+
diff --git a/mysql-test/lib/My/SysInfo.pm b/mysql-test/lib/My/SysInfo.pm
new file mode 100644
index 00000000..211f72c0
--- /dev/null
+++ b/mysql-test/lib/My/SysInfo.pm
@@ -0,0 +1,206 @@
+# -*- cperl -*-
+# Copyright (c) 2008, 2013, 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-1335 USA
+
+
+package My::SysInfo;
+
+use strict;
+use Carp;
+use My::Platform;
+
+use constant DEFAULT_BOGO_MIPS => 2000;
+
+sub _cpuinfo {
+ my ($self)= @_;
+
+ my $info_file= "/proc/cpuinfo";
+ if ( !( -e $info_file and -f $info_file) ) {
+ return undef;
+ }
+
+ my $F= IO::File->new($info_file) or return undef;
+
+ # Set input separator to blank line
+ local $/ = '';
+
+ while ( my $cpu_chunk= <$F>) {
+ chomp($cpu_chunk);
+
+ my $cpuinfo = {};
+
+ foreach my $cpuline ( split(/\n/, $cpu_chunk) ) {
+ my ( $attribute, $value ) = split(/\s*:\s*/, $cpuline);
+
+ $attribute =~ s/\s+/_/;
+ $attribute = lc($attribute);
+
+ if ( $value =~ /^(no|not available|yes)$/ ) {
+ $value = $value eq 'yes' ? 1 : 0;
+ }
+
+ if ( $attribute eq 'flags' ) {
+ @{ $cpuinfo->{flags} } = split / /, $value;
+ } else {
+ $cpuinfo->{$attribute} = $value;
+ }
+ }
+
+ # Make sure bogomips is set to some value
+ $cpuinfo->{bogomips} ||= DEFAULT_BOGO_MIPS;
+
+ # Cpus reported once, but with 'cpu_count' set to the actual number
+ my $cpu_count= $cpuinfo->{cpu_count} || 1;
+ for(1..$cpu_count){
+ push(@{$self->{cpus}}, $cpuinfo);
+ }
+ }
+ $F= undef; # Close file
+ return $self->{cpus};
+}
+
+
+sub _kstat {
+ my ($self)= @_;
+ while (1){
+ my $instance_num= $self->{cpus} ? @{$self->{cpus}} : 0;
+ my $list= `kstat -p -m cpu_info -i $instance_num 2> /dev/null`;
+ my @lines= split('\n', $list) or last; # Break loop
+
+ my $cpuinfo= {};
+ foreach my $line (@lines)
+ {
+ my ($module, $instance, $name, $statistic, $value)=
+ $line=~ /(\w*):(\w*):(\w*):(\w*)\t(.*)/;
+
+ $cpuinfo->{$statistic}= $value;
+ }
+
+ # Default value, the actual cpu values can be used to decrease this
+ # on slower cpus
+ $cpuinfo->{bogomips}= DEFAULT_BOGO_MIPS;
+
+ push(@{$self->{cpus}}, $cpuinfo);
+ }
+
+ return $self->{cpus};
+}
+
+
+sub _unamex {
+ my ($self)= @_;
+ # TODO
+ return undef;
+}
+
+
+sub new {
+ my ($class)= @_;
+
+
+ my $self= bless {
+ cpus => (),
+ }, $class;
+
+ my @info_methods =
+ (
+ \&_cpuinfo,
+ \&_kstat,
+ \&_unamex,
+ );
+
+ # Detect virtual machines
+ my $isvm= 0;
+
+ if (IS_WINDOWS) {
+ # Detect vmware service
+ $isvm= `tasklist` =~ /vmwareservice/i;
+ }
+ $self->{isvm}= $isvm;
+
+ foreach my $method (@info_methods){
+ if ($method->($self)){
+ return $self;
+ }
+ }
+
+ # Push a dummy cpu
+ push(@{$self->{cpus}},
+ {
+ bogomips => DEFAULT_BOGO_MIPS,
+ model_name => "unknown",
+ });
+
+ return $self;
+}
+
+
+# Return the list of cpus found
+sub cpus {
+ my ($self)= @_;
+ return @{$self->{cpus}} or
+ confess "INTERNAL ERROR: No cpus in list";
+}
+
+
+# Return the number of cpus found
+sub num_cpus {
+ my ($self)= @_;
+ return int(@{$self->{cpus}}) or
+ confess "INTERNAL ERROR: No cpus in list";
+}
+
+
+# Return the smallest bogomips value amongst the processors
+sub min_bogomips {
+ my ($self)= @_;
+
+ my $bogomips;
+
+ foreach my $cpu (@{$self->{cpus}}) {
+ if (!defined $bogomips or $bogomips > $cpu->{bogomips}) {
+ $bogomips= $cpu->{bogomips};
+ }
+ }
+
+ return $bogomips;
+}
+
+sub isvm {
+ my ($self)= @_;
+
+ return $self->{isvm};
+}
+
+
+# Prit the cpuinfo
+sub print_info {
+ my ($self)= @_;
+
+ foreach my $cpu (@{$self->{cpus}}) {
+ while ((my ($key, $value)) = each(%$cpu)) {
+ print " ", $key, "= ";
+ if (ref $value eq "ARRAY") {
+ print "[", join(", ", @$value), "]";
+ } else {
+ print $value;
+ }
+ print "\n";
+ }
+ print "\n";
+ }
+}
+
+1;
diff --git a/mysql-test/lib/My/Tee.pm b/mysql-test/lib/My/Tee.pm
new file mode 100644
index 00000000..8d6b4ddd
--- /dev/null
+++ b/mysql-test/lib/My/Tee.pm
@@ -0,0 +1,25 @@
+package My::Tee;
+use IO::Handle;
+
+# see PerlIO::via
+
+our $copyfh;
+
+sub PUSHED
+{
+ open($copyfh, '>', "$::opt_vardir/log/stdout.log")
+ or die "open(>$::opt_vardir/log/stdout.log): $!"
+ unless $copyfh;
+ bless { }, shift;
+}
+
+sub WRITE
+{
+ my ($obj, $buf, $fh) = @_;
+ print $fh $buf;
+ $fh->flush;
+ print $copyfh $buf;
+ return length($buf);
+}
+
+1;
diff --git a/mysql-test/lib/My/Test.pm b/mysql-test/lib/My/Test.pm
new file mode 100644
index 00000000..56e7cf6d
--- /dev/null
+++ b/mysql-test/lib/My/Test.pm
@@ -0,0 +1,120 @@
+# -*- cperl -*-
+# 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.
+#
+# 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-1335 USA
+
+
+#
+# One test
+#
+package My::Test;
+
+use strict;
+use warnings;
+use Carp;
+use Storable();
+use mtr_results;
+
+
+sub new {
+ my $class= shift;
+ my $self= bless {
+ @_,
+ }, $class;
+ return $self;
+}
+
+sub copy {
+ my $self= shift;
+ my $copy= My::Test->new();
+ while (my ($key, $value) = each(%$self)) {
+ if (ref $value eq "ARRAY") {
+ $copy->{$key} = [ @$value ];
+ } else {
+ $copy->{$key}= $value;
+ }
+ }
+ $copy;
+}
+
+sub fullname {
+ my ($self)= @_;
+ $self->{name} . (defined $self->{combinations}
+ ? " '" . join(',', sort @{$self->{combinations}}) . "'"
+ : "")
+}
+
+#
+# Return a unique key that can be used to
+# identify this test in a hash
+#
+sub key {
+ my ($self)= @_;
+ return $self->{key};
+}
+
+
+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');
+}
+
+
+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};
+
+ my $serialized= Storable::freeze($test);
+ $serialized =~ s/([\x0d\x0a\\])/sprintf("\\%02x", ord($1))/eg;
+ send $sock,$header. "\n". $serialized. "\n", 0;
+}
+
+
+sub read_test {
+ my ($sock)= @_;
+ my $serialized= <$sock>;
+ chomp($serialized);
+ $serialized =~ s/\\([0-9a-fA-F]{2})/chr(hex($1))/eg;
+ my $test= Storable::thaw($serialized);
+ use Data::Dumper;
+ confess "Not My::Test: ". ref($test). "\n". Dumper(\$test, $serialized)
+ unless ref($test) eq 'My::Test';
+ resfile_from_test($test) if $::opt_resfile;
+ return $test;
+}
+
+1;
diff --git a/mysql-test/lib/generate-ssl-certs.sh b/mysql-test/lib/generate-ssl-certs.sh
new file mode 100755
index 00000000..57caf3b7
--- /dev/null
+++ b/mysql-test/lib/generate-ssl-certs.sh
@@ -0,0 +1,66 @@
+#!/bin/sh
+
+set -xe
+
+# simply run me from mysql-test/
+cd std_data/
+
+# boilerplace for "openssl ca" and /etc/ssl/openssl.cnf
+rm -rf demoCA
+mkdir demoCA demoCA/newcerts
+touch demoCA/index.txt
+touch demoCA/index.txt.attr
+echo 01 > demoCA/serial
+echo 01 > demoCA/crlnumber
+
+# Use rsa:3072 at minimum for all keys to be future compatible with next OpenSSL releases
+# See level 3 in https://www.openssl.org/docs/man1.1.0/man3/SSL_CTX_set_security_level.html
+# Following industry practice, jump directly to rsa:4096 instead of just rsa:3072.
+
+# CA certificate, self-signed
+openssl req -x509 -newkey rsa:4096 -keyout cakey.pem -out cacert.pem -days 7300 -nodes -subj '/CN=cacert/C=FI/ST=Helsinki/L=Helsinki/O=MariaDB' -text
+
+# server certificate signing request and private key. Note the very long subject (for MDEV-7859)
+openssl req -newkey rsa:4096 -keyout server-key.pem -out demoCA/server-req.pem -days 7300 -nodes -subj '/CN=localhost/C=FI/ST=state or province within country, in other certificates in this file it is the same as L/L=location, usually an address but often ambiguously used/OU=organizational unit name, a division name within an organization/O=organization name, typically a company name'
+# convert the key to yassl compatible format
+openssl rsa -in server-key.pem -out server-key.pem
+# sign the server certificate with CA certificate
+openssl ca -keyfile cakey.pem -days 7300 -batch -cert cacert.pem -policy policy_anything -out server-cert.pem -in demoCA/server-req.pem
+
+# server certificate with different validity period (MDEV-7598)
+openssl req -newkey rsa:4096 -keyout server-new-key.pem -out demoCA/server-new-req.pem -days 7301 -nodes -subj '/CN=server-new/C=FI/ST=Helsinki/L=Helsinki/O=MariaDB'
+openssl rsa -in server-new-key.pem -out server-new-key.pem
+openssl ca -keyfile cakey.pem -days 7301 -batch -cert cacert.pem -policy policy_anything -out server-new-cert.pem -in demoCA/server-new-req.pem
+
+# 8K cert
+openssl req -newkey rsa:8192 -keyout server8k-key.pem -out demoCA/server8k-req.pem -days 7300 -nodes -subj '/CN=server8k/C=FI/ST=Helsinki/L=Helsinki/O=MariaDB'
+openssl rsa -in server8k-key.pem -out server8k-key.pem
+openssl ca -keyfile cakey.pem -days 7300 -batch -cert cacert.pem -policy policy_anything -out server8k-cert.pem -in demoCA/server8k-req.pem
+
+# with SubjectAltName, only for OpenSSL 1.0.2+
+cat > demoCA/sanext.conf <<EOF
+subjectAltName=IP:127.0.0.1, DNS:localhost
+EOF
+openssl req -newkey rsa:4096 -keyout serversan-key.pem -out demoCA/serversan-req.pem -days 7300 -nodes -subj '/CN=server/C=FI/ST=Helsinki/L=Helsinki/O=MariaDB'
+openssl ca -keyfile cakey.pem -extfile demoCA/sanext.conf -days 7300 -batch -cert cacert.pem -policy policy_anything -out serversan-cert.pem -in demoCA/serversan-req.pem
+
+# client cert
+openssl req -newkey rsa:4096 -keyout client-key.pem -out demoCA/client-req.pem -days 7300 -nodes -subj '/CN=client/C=FI/ST=Helsinki/L=Helsinki/O=MariaDB'
+openssl rsa -in client-key.pem -out client-key.pem
+openssl ca -keyfile cakey.pem -days 7300 -batch -cert cacert.pem -policy policy_anything -out client-cert.pem -in demoCA/client-req.pem
+
+# generate combined client cert and key file
+cat client-cert.pem client-key.pem > client-certkey.pem
+
+# generate crls
+openssl ca -revoke server-cert.pem -keyfile cakey.pem -batch -cert cacert.pem
+openssl ca -gencrl -keyfile cakey.pem -crldays 7300 -batch -cert cacert.pem -out server-cert.crl
+# we only want to have one certificate per CRL. Un-revoke server-cert.crl
+cp demoCA/index.txt.old demoCA/index.txt
+openssl ca -revoke client-cert.pem -keyfile cakey.pem -batch -cert cacert.pem
+openssl ca -gencrl -keyfile cakey.pem -crldays 7300 -batch -cert cacert.pem -out client-cert.crl
+
+rm -fv crldir/*
+cp -v client-cert.crl crldir/`openssl x509 -in client-cert.pem -noout -issuer_hash`.r0
+
+rm -rf demoCA
diff --git a/mysql-test/lib/mtr_cases.pm b/mysql-test/lib/mtr_cases.pm
new file mode 100644
index 00000000..41d943e3
--- /dev/null
+++ b/mysql-test/lib/mtr_cases.pm
@@ -0,0 +1,1191 @@
+# -*- cperl -*-
+# Copyright (c) 2005, 2011, Oracle and/or its affiliates.
+# Copyright (c) 2010, 2011 Monty Program 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-1335 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.
+
+package mtr_cases;
+use strict;
+
+use base qw(Exporter);
+our @EXPORT= qw(collect_option collect_test_cases collect_default_suites);
+
+use Carp;
+
+use mtr_report;
+use mtr_match;
+
+# Options used for the collect phase
+our $skip_rpl;
+our $do_test;
+our $skip_test;
+our $binlog_format;
+our $enable_disabled;
+
+sub collect_option {
+ my ($opt, $value)= @_;
+
+ # Evaluate $opt as string to use "Getopt::Long::Callback legacy API"
+ my $opt_name = "$opt";
+
+ # Convert - to _ in option name
+ $opt_name =~ s/-/_/g;
+ no strict 'refs';
+ ${$opt_name}= $value;
+}
+
+use File::Basename;
+use File::Spec::Functions qw /splitdir/;
+use IO::File();
+use My::Config;
+use My::Platform;
+use My::Test;
+use My::Find;
+use My::Suite;
+
+# locate plugin suites, depending on whether it's a build tree or installed
+my @plugin_suitedirs;
+my $plugin_suitedir_regex;
+my $overlay_regex;
+
+if (-d '../sql') {
+ @plugin_suitedirs= ('storage/*/mysql-test', 'plugin/*/mysql-test', 'storage/*/*/mysql-test', );
+ $overlay_regex= '\b(?:storage|plugin|storage[/][^/]*)/(\w+)/mysql-test\b';
+} else {
+ @plugin_suitedirs= ('mysql-test/plugin/*');
+ $overlay_regex= '\bmysql-test/plugin/(\w+)\b';
+}
+$plugin_suitedir_regex= $overlay_regex;
+$plugin_suitedir_regex=~ s/\Q(\w+)\E/\\w+/;
+
+# Precompiled regex's for tests to do or skip
+my $do_test_reg;
+my $skip_test_reg;
+
+my %suites;
+
+sub init_pattern {
+ my ($from, $what)= @_;
+ return undef unless defined $from;
+ if ( $from =~ /^[a-z0-9\.]*$/ ) {
+ # Does not contain any regex (except . that we allow as
+ # separator betwen suite and testname), make the pattern match
+ # beginning of string
+ $from= "^$from";
+ mtr_verbose2("$what='$from'");
+ }
+ # Check that pattern is a valid regex
+ eval { "" =~/$from/; 1 } or
+ mtr_error("Invalid regex '$from' passed to $what\nPerl says: $@");
+ return $from;
+}
+
+
+##############################################################################
+#
+# Collect information about test cases to be run
+#
+##############################################################################
+
+sub collect_test_cases ($$$$) {
+ my $opt_reorder= shift; # True if we're reordering tests
+ my $suites= shift; # Semicolon separated list of test suites
+ my $opt_cases= shift;
+ my $opt_skip_test_list= shift;
+ my $cases= []; # Array of hash(one hash for each testcase)
+
+ $do_test_reg= init_pattern($do_test, "--do-test");
+ $skip_test_reg= init_pattern($skip_test, "--skip-test");
+
+ parse_disabled($_) for @$opt_skip_test_list;
+
+ # If not reordering, we also shouldn't group by suites, unless
+ # no test cases were named.
+ # This also affects some logic in the loop following this.
+ if ($opt_reorder or !@$opt_cases)
+ {
+ foreach my $suite (split(",", $suites))
+ {
+ push(@$cases, collect_suite_name($suite, $opt_cases));
+ }
+ }
+
+ if ( @$opt_cases )
+ {
+ # A list of tests was specified on the command line
+ # Check that the tests specified were found
+ # in at least one suite
+ foreach my $test_name_spec ( @$opt_cases )
+ {
+ my $found= 0;
+ my ($sname, $tname)= split_testname($test_name_spec);
+ foreach my $test ( @$cases )
+ {
+ last unless $opt_reorder;
+ # test->{name} is always in suite.name format
+ if ( $test->{name} =~ /^$sname.*\.$tname$/ )
+ {
+ $found= 1;
+ last;
+ }
+ }
+ if ( not $found )
+ {
+ $sname= "main" if !$opt_reorder and !$sname;
+ mtr_error("Could not find '$tname' in '$suites' suite(s)") unless $sname;
+ # If suite was part of name, find it there, may come with combinations
+ my @this_case = collect_suite_name($sname, [ $test_name_spec ]);
+ if (@this_case)
+ {
+ push (@$cases, @this_case);
+ }
+ elsif ($::opt_skip_not_found)
+ {
+ push @$cases, My::Test->new
+ (
+ name => "$sname.$tname",
+ shortname => $tname,
+ skip => 1,
+ comment => 'not found',
+ );
+ }
+ else
+ {
+ mtr_error("Could not find '$tname' in '$sname' suite");
+ }
+ }
+ }
+ }
+
+ if ( $opt_reorder )
+ {
+ # Make a mapping of test name to a string that represents how that test
+ # should be sorted among the other tests. Put the most important criterion
+ # first, then a sub-criterion, then sub-sub-criterion, etc.
+ foreach my $tinfo (@$cases)
+ {
+ my @criteria = ();
+
+ #
+ # Collect the criteria for sorting, in order of importance.
+ # Note that criteria are also used in mysql-test-run.pl to
+ # schedule tests to workers, and it preferres tests that have
+ # *identical* criteria. That is, test name is *not* part of
+ # the criteria, but it's part of the sorting function below.
+ #
+ push(@criteria, $tinfo->{template_path});
+ for (qw(master_opt slave_opt)) {
+ # Group test with equal options together.
+ # Ending with "~" makes empty sort later than filled
+ my $opts= $tinfo->{$_} ? $tinfo->{$_} : [];
+ push(@criteria, join("!", sort @{$opts}) . "~");
+ }
+ $tinfo->{criteria}= join(" ", @criteria);
+ }
+
+ @$cases = sort { # ORDER BY
+ $b->{skip} <=> $a->{skip} || # skipped DESC,
+ $a->{criteria} cmp $b->{criteria} || # criteria ASC,
+ $b->{long_test} <=> $a->{long_test} || # long_test DESC,
+ $a->{name} cmp $b->{name} # name ASC
+ } @$cases;
+ }
+
+ return $cases;
+}
+
+
+# Returns (suitename, testname, combinations....)
+sub split_testname {
+ my ($test_name)= @_;
+
+ # If .test file name is used, get rid of directory part
+ $test_name= basename($test_name) if $test_name =~ /\.test$/;
+
+ # Then, get the combinations:
+ my ($test_name, @combs) = split /,/, $test_name;
+
+ # Now split name on .'s
+ my @parts= split(/\./, $test_name);
+
+ if (@parts == 1){
+ # Only testname given, ex: alias
+ return (undef , $parts[0], @combs);
+ } elsif (@parts == 2) {
+ # Either testname.test or suite.testname given
+ # Ex. main.alias or alias.test
+
+ if ($parts[1] eq "test")
+ {
+ return (undef , $parts[0], @combs);
+ }
+ else
+ {
+ return ($parts[0], $parts[1], @combs);
+ }
+ }
+
+ mtr_error("Illegal format of test name: $test_name");
+}
+
+our %file_to_tags;
+our %file_to_master_opts;
+our %file_to_slave_opts;
+our %file_combinations;
+our %skip_combinations;
+our %file_in_overlay;
+
+sub load_suite_object {
+ my ($suitename, $suitedir) = @_;
+ my $suite;
+ unless (defined $suites{$suitename}) {
+ if (-f "$suitedir/suite.pm") {
+ $suite= do "$suitedir/suite.pm";
+ mtr_error("Cannot load $suitedir/suite.pm: $@") if $@;
+ unless (ref $suite) {
+ my $comment = $suite;
+ $suite = My::Suite->new();
+ $suite->{skip} = $comment;
+ }
+ } else {
+ $suite = My::Suite->new();
+ }
+
+ $suites{$suitename} = $suite;
+
+ # add suite skiplist to a global hash, so that we can check it
+ # with only one lookup
+ my %suite_skiplist = $suite->skip_combinations();
+ while (my ($file, $skiplist) = each %suite_skiplist) {
+ $file =~ s/\.\w+$/\.combinations/;
+ if (ref $skiplist) {
+ $skip_combinations{"$suitedir/$file => $_"} = 1 for (@$skiplist);
+ } else {
+ $skip_combinations{"$suitedir/$file"} = $skiplist;
+ }
+ }
+ }
+ return $suites{$suitename};
+}
+
+
+# returns a pair of (suite, suitedir)
+sub suite_for_file($) {
+ my ($file) = @_;
+ return ($2, $1) if $file =~ m@^(.*/$plugin_suitedir_regex/(\w+))/@o;
+ return ($2, $1) if $file =~ m@^(.*/mysql-test/suite/(\w+))/@;
+ return ('main', $1) if $file =~ m@^(.*/mysql-test)/@;
+ mtr_error("Cannot determine suite for $file");
+}
+
+sub combinations_from_file($$)
+{
+ my ($in_overlay, $filename) = @_;
+ my @combs;
+ if ($skip_combinations{$filename}) {
+ @combs = ({ skip => $skip_combinations{$filename} });
+ } else {
+ return () if @::opt_combinations or not -f $filename;
+ return () if ::using_extern();
+ # Read combinations file in my.cnf format
+ mtr_verbose2("Read combinations file $filename");
+ my $config= My::Config->new($filename);
+ foreach my $group ($config->option_groups()) {
+ my $comb= { name => $group->name(), comb_opt => [] };
+ next if $skip_combinations{"$filename => $comb->{name}"};
+ foreach my $option ( $group->options() ) {
+ push(@{$comb->{comb_opt}}, $option->option());
+ }
+ $comb->{in_overlay} = 1 if $in_overlay;
+ push @combs, $comb;
+ }
+ @combs = ({ skip => 'Requires: ' . basename($filename, '.combinations') }) unless @combs;
+ }
+ @combs;
+}
+
+our %disabled;
+our %disabled_wildcards;
+sub parse_disabled {
+ my ($filename, $suitename) = @_;
+
+ if (open(DISABLED, $filename)) {
+ while (<DISABLED>) {
+ chomp;
+ next if /^\s*#/ or /^\s*$/;
+ mtr_error("Syntax error in $filename line $.")
+ unless /^\s*(?:([-0-9A-Za-z_\/]+)\.)?([-0-9A-Za-z_#\*]+)\s*:\s*(.*?)\s*$/;
+ mtr_error("Wrong suite name in $filename line $.: suitename = $suitename but the file says $1")
+ if defined $1 and defined $suitename and $1 ne $suitename;
+ my ($sname, $casename, $text)= (($1 || $suitename || ''), $2, $3);
+
+ if ($casename =~ /\*/) {
+ # Wildcard
+ $disabled_wildcards{$sname . ".$casename"}= $text;
+ }
+ else {
+ $disabled{$sname . ".$casename"}= $text;
+ }
+ }
+ close DISABLED;
+ }
+}
+
+#
+# load suite.pm files from plugin suites
+# collect the list of default plugin suites.
+# XXX currently it does not support nested suites
+#
+sub collect_default_suites(@)
+{
+ use File::Find;
+ my @dirs;
+ find(sub {
+ push @dirs, [$File::Find::topdir, $File::Find::name]
+ if -d and -f "$File::Find::name/suite.pm";
+ }, my_find_dir(dirname($::glob_mysql_test_dir), \@plugin_suitedirs));
+
+ for (@dirs) {
+ my ($plugin_root, $dir) = @$_;
+ my $sname= substr $dir, 1 + length $plugin_root;
+ # ignore overlays here, otherwise we'd need accurate
+ # duplicate detection with overlay support for the default suite list
+ next if $sname eq 'main' or -d "$::glob_mysql_test_dir/suite/$sname";
+ my $s = load_suite_object($sname, $dir);
+ push @_, $sname if $s->is_default();
+ }
+ return @_;
+}
+
+
+#
+# processes one user-specified suite name.
+# it could contain wildcards, e.g engines/*
+#
+sub collect_suite_name($$)
+{
+ my $suitename= shift; # Test suite name
+ my $opt_cases= shift;
+ my $over;
+ my %suites;
+
+ ($suitename, $over) = split '-', $suitename;
+
+ if ( $suitename ne "main" )
+ {
+ # Allow suite to be path to "some dir" if $suitename has at least
+ # one directory part
+ if ( -d $suitename and splitdir($suitename) > 1 ) {
+ $suites{$suitename} = [ $suitename ];
+ mtr_report(" - from '$suitename'");
+ }
+ else
+ {
+ my @dirs = my_find_dir(dirname($::glob_mysql_test_dir),
+ ["mysql-test/suite", @plugin_suitedirs ],
+ $suitename);
+ #
+ # if $suitename contained wildcards, we'll have many suites and
+ # their overlays here. Let's group them appropriately.
+ #
+ for (@dirs) {
+ m@^.*/(?:mysql-test/suite|$plugin_suitedir_regex)/(.*)$@o or confess $_;
+ push @{$suites{$1}}, $_;
+ }
+ }
+ } else {
+ $suites{$suitename} = [ $::glob_mysql_test_dir . "/main",
+ my_find_dir(dirname($::glob_mysql_test_dir),
+ [ @plugin_suitedirs ],
+ 'main', NOT_REQUIRED) ];
+ }
+
+ my @cases;
+ while (my ($name, $dirs) = each %suites) {
+ #
+ # XXX at the moment, for simplicity, we will not fully support one
+ # plugin overlaying a suite of another plugin. Only suites in the main
+ # mysql-test directory can be safely overlayed. To be fixed, when
+ # needed. To fix it we'll need a smarter overlay detection (that is,
+ # detection of what is an overlay and what is the "original" suite)
+ # than simply "prefer directories with more files".
+ #
+ if ($dirs->[0] !~ m@/mysql-test/suite/$name$@) {
+ # prefer directories with more files
+ @$dirs = sort { scalar(<$a/*>) <=> scalar(<$b/*>) } @$dirs;
+ }
+ push @cases, collect_one_suite($opt_cases, $name, $over, @$dirs);
+ }
+ return @cases;
+}
+
+sub collect_one_suite {
+ my ($opt_cases, $suitename, $over, $suitedir, @overlays) = @_;
+
+ mtr_verbose2("Collecting: $suitename");
+ mtr_verbose2("suitedir: $suitedir");
+ mtr_verbose2("overlays: @overlays") if @overlays;
+
+ # we always need to process the parent suite, even if we won't use any
+ # test from it.
+ my @cases= process_suite($suitename, undef, $suitedir,
+ $over ? [ '*BOGUS*' ] : $opt_cases);
+
+ # when working with overlays we cannot use global caches like
+ # %file_to_tags. Because the same file may have different tags
+ # with and without overlays. For example, when a.test includes
+ # b.inc, which includes c.inc, and an overlay replaces c.inc.
+ # In this case b.inc may have different tags in the overlay,
+ # despite the fact that b.inc itself is not replaced.
+ for (@overlays) {
+ local %file_to_tags = ();
+ local %file_to_master_opts = ();
+ local %file_to_slave_opts = ();
+ local %file_combinations = ();
+ local %file_in_overlay = ();
+
+ confess $_ unless m@/$overlay_regex/@o;
+ next unless defined $over and ($over eq '' or $over eq $1);
+ push @cases,
+ # don't add cases that take *all* data from the parent suite
+ grep { $_->{in_overlay} } process_suite($suitename, $1, $_, $opt_cases);
+ }
+ return @cases;
+}
+
+sub process_suite {
+ my ($basename, $overname, $suitedir, $opt_cases) = @_;
+ my $suitename;
+ my $parent;
+
+ if ($overname) {
+ $parent = $suites{$basename};
+ confess unless $parent;
+ $suitename = $basename . '-' . $overname;
+ } else {
+ $suitename = $basename;
+ }
+
+ my $suite = load_suite_object($suitename, (($suitename eq "main") ?
+ $::glob_mysql_test_dir :
+ $suitedir));
+
+ #
+ # Read suite config files, unless it was done aleady
+ #
+ unless (defined $suite->{name}) {
+ $suite->{name} = $suitename;
+ $suite->{dir} = $suitedir;
+
+ # First, we need to find where the test files and result files are.
+ # test files are usually in a t/ dir inside suite dir. Or directly in the
+ # suite dir. result files are in a r/ dir or in the suite dir.
+ # Overlay uses t/ and r/ if and only if its parent does.
+ if ($parent) {
+ $suite->{parent} = $parent;
+ my $tdir = $parent->{tdir};
+ my $rdir = $parent->{rdir};
+ substr($tdir, 0, length $parent->{dir}) = $suitedir;
+ substr($rdir, 0, length $parent->{dir}) = $suitedir;
+ $suite->{tdir} = $tdir if -d $tdir;
+ $suite->{rdir} = $rdir if -d $rdir;
+ } else {
+ my $tdir= "$suitedir/t";
+ my $rdir= "$suitedir/r";
+ $suite->{tdir} = -d $tdir ? $tdir : $suitedir;
+ $suite->{rdir} = -d $rdir ? $rdir : $suite->{tdir};
+ }
+
+ mtr_verbose2("testdir: " . $suite->{tdir});
+ mtr_verbose2( "resdir: " . $suite->{rdir});
+
+ # disabled.def
+ parse_disabled($suite->{dir} .'/disabled.def', $suitename);
+ parse_disabled($suite->{dir} .'/t/disabled.def', $suitename);
+
+ # combinations
+ if (@::opt_combinations)
+ {
+ # take the combination from command-line
+ mtr_verbose2("Take the combination from command line");
+ foreach my $combination (@::opt_combinations) {
+ my $comb= {};
+ $comb->{name}= $combination;
+ push(@{$comb->{comb_opt}}, $combination);
+ push @{$suite->{combinations}}, $comb;
+ }
+ }
+ else
+ {
+ my @combs;
+ my $from = "$suitedir/combinations";
+ @combs = combinations_from_file($parent, $from) unless $suite->{skip};
+ $suite->{combinations} = [ @combs ];
+ # in overlays it's a union of parent's and overlay's files.
+ unshift @{$suite->{combinations}},
+ grep { not $skip_combinations{"$from => $_->{name}"} }
+ @{$parent->{combinations}} if $parent;
+ }
+
+ # suite.opt
+ # in overlays it's a union of parent's and overlay's files.
+ $suite->{opts} = [ opts_from_file("$suitedir/suite.opt") ];
+ $suite->{in_overlay} = 1 if $parent and @{$suite->{opts}};
+ unshift @{$suite->{opts}}, @{$parent->{opts}} if $parent;
+
+ $suite->{cases} = [ $suite->list_cases($suite->{tdir}) ];
+ }
+
+ my %all_cases;
+ %all_cases = map { $_ => $parent->{tdir} } @{$parent->{cases}} if $parent;
+ $all_cases{$_} = $suite->{tdir} for @{$suite->{cases}};
+
+ my @cases;
+ if (@$opt_cases) {
+ # Collect in specified order
+ foreach my $test_name_spec ( @$opt_cases )
+ {
+ my ($sname, $tname, @combs)= split_testname($test_name_spec);
+
+ # Check correct suite if suitename is defined
+ next if defined $sname and $sname ne $suitename
+ and $sname ne "$basename-";
+
+ next unless $all_cases{$tname};
+ push @cases, collect_one_test_case($suite, $all_cases{$tname}, $tname, @combs);
+ }
+ } else {
+ for (sort keys %all_cases)
+ {
+ # Skip tests that do not match the --do-test= filter
+ next if $do_test_reg and not /$do_test_reg/o;
+ push @cases, collect_one_test_case($suite, $all_cases{$_}, $_);
+ }
+ }
+
+ @cases;
+}
+
+#
+# Read options from the given opt file and append them as an array
+# to $tinfo->{$opt_name}
+#
+sub process_opts {
+ my ($tinfo, $opt_name)= @_;
+
+ my @opts= @{$tinfo->{$opt_name}};
+ $tinfo->{$opt_name} = [];
+
+ foreach my $opt (@opts)
+ {
+ my $value;
+
+ # The opt file is used both to send special options to the mysqld
+ # as well as pass special test case specific options to this
+ # script
+
+ $value= mtr_match_prefix($opt, "--timezone=");
+ if ( defined $value )
+ {
+ $tinfo->{'timezone'}= $value;
+ next;
+ }
+
+ # If we set default time zone, remove the one we have
+ $value= mtr_match_prefix($opt, "--default-time-zone=");
+ if ( defined $value )
+ {
+ # Set timezone for this test case to something different
+ $tinfo->{'timezone'}= "GMT-8";
+ # Fallthrough, add the --default-time-zone option
+ }
+
+ # Ok, this was a real option, add it
+ push(@{$tinfo->{$opt_name}}, $opt);
+ }
+}
+
+sub make_combinations($$@)
+{
+ my ($test, $test_combs, @combinations) = @_;
+
+ return ($test) unless @combinations;
+ if ($combinations[0]->{skip}) {
+ $test->{skip} = 1;
+ $test->{comment} = $combinations[0]->{skip} unless $test->{comment};
+ confess unless @combinations == 1;
+ return ($test);
+ }
+
+ foreach my $comb (@combinations)
+ {
+ # Skip all other combinations if the values they change
+ # are already fixed in master_opt or slave_opt
+ # (empty combinations are not considered a subset of anything)
+ if (@{$comb->{comb_opt}} &&
+ My::Options::is_subset($test->{master_opt}, $comb->{comb_opt}) &&
+ My::Options::is_subset($test->{slave_opt}, $comb->{comb_opt}) ){
+
+ $test_combs->{$comb->{name}} = 2;
+
+ # Add combination name short name
+ push @{$test->{combinations}}, $comb->{name};
+
+ return ($test);
+ }
+
+ # Skip all other combinations, if this combination is forced
+ if ($test_combs->{$comb->{name}}) {
+ @combinations = ($comb); # run the loop below only for this combination
+ $test_combs->{$comb->{name}} = 2;
+ last;
+ }
+ }
+
+ return ($test) if $test->{'skip'};
+
+ my @cases;
+ foreach my $comb (@combinations)
+ {
+ # Copy test options
+ my $new_test= $test->copy();
+
+ # Prepend the combination options to master_opt and slave_opt
+ # (on the command line combinations go *before* .opt files)
+ unshift @{$new_test->{master_opt}}, @{$comb->{comb_opt}};
+ unshift @{$new_test->{slave_opt}}, @{$comb->{comb_opt}};
+
+ # Add combination name short name
+ push @{$new_test->{combinations}}, $comb->{name};
+
+ $new_test->{in_overlay} = 1 if $comb->{in_overlay};
+
+ # Add the new test to new test cases list
+ push(@cases, $new_test);
+ }
+ return @cases;
+}
+
+
+sub find_file_in_dirs
+{
+ my ($tinfo, $slot, $filename) = @_;
+ my $parent = $tinfo->{suite}->{parent};
+ my $f = $tinfo->{suite}->{$slot} . '/' . $filename;
+
+ if (-f $f) {
+ $tinfo->{in_overlay} = 1 if $parent;
+ return $f;
+ }
+
+ return undef unless $parent;
+
+ $f = $parent->{$slot} . '/' . $filename;
+ return -f $f ? $f : undef;
+}
+
+##############################################################################
+#
+# Collect information about a single test case
+#
+##############################################################################
+
+sub collect_one_test_case {
+ my $suite = shift;
+ my $tpath = shift;
+ my $tname = shift;
+ my %test_combs = map { $_ => 1 } @_;
+ my $suitename = $suite->{name};
+ my $name = "$suitename.$tname";
+ my $filename = "$tpath/${tname}.test";
+
+ # ----------------------------------------------------------------------
+ # Set defaults
+ # ----------------------------------------------------------------------
+ my $tinfo= My::Test->new
+ (
+ name => $name,
+ shortname => $tname,
+ path => $filename,
+ suite => $suite,
+ in_overlay => $suite->{in_overlay},
+ master_opt => [ @{$suite->{opts}} ],
+ slave_opt => [ @{$suite->{opts}} ],
+ );
+
+ # ----------------------------------------------------------------------
+ # Skip some tests but include in list, just mark them as skipped
+ # ----------------------------------------------------------------------
+ if ( $skip_test_reg and ($tname =~ /$skip_test_reg/o or
+ $name =~ /$skip_test_reg/o))
+ {
+ $tinfo->{'skip'}= 1;
+ return $tinfo;
+ }
+
+ # ----------------------------------------------------------------------
+ # Check for disabled tests
+ # ----------------------------------------------------------------------
+ my $disable = $disabled{".$tname"} || $disabled{$name};
+ if (not $disable) {
+ foreach my $w (keys %disabled_wildcards) {
+ if ($name =~ /^$w/) {
+ $disable= $disabled_wildcards{$w};
+ last;
+ }
+ }
+ }
+ if (not defined $disable and $suite->{parent}) {
+ $disable = $disabled{$suite->{parent}->{name} . ".$tname"};
+ }
+ if (defined $disable)
+ {
+ $tinfo->{comment}= $disable;
+ if ( $enable_disabled )
+ {
+ # User has selected to run all disabled tests
+ mtr_report(" - $tinfo->{name} will be run although it's been disabled\n",
+ " due to '$disable'");
+ }
+ else
+ {
+ $tinfo->{'skip'}= 1;
+ $tinfo->{'disable'}= 1; # Sub type of 'skip'
+
+ # we can stop test file processing early if the test if disabled, but
+ # only if we're not in the overlay. for overlays we want to know exactly
+ # whether the test is ignored (in_overlay=0) or disabled.
+ return $tinfo unless $suite->{parent};
+ }
+ }
+
+ if ($suite->{skip}) {
+ $tinfo->{skip}= 1;
+ $tinfo->{comment}= $suite->{skip} unless $tinfo->{comment};
+ return $tinfo unless $suite->{parent};
+ }
+
+ # ----------------------------------------------------------------------
+ # Check for test specific config file
+ # ----------------------------------------------------------------------
+ my $test_cnf_file= find_file_in_dirs($tinfo, tdir => "$tname.cnf");
+ if ($test_cnf_file ) {
+ # Specifies the configuration file to use for this test
+ $tinfo->{'template_path'}= $test_cnf_file;
+ }
+
+ # ----------------------------------------------------------------------
+ # master sh
+ # ----------------------------------------------------------------------
+ my $master_sh= find_file_in_dirs($tinfo, tdir => "$tname-master.sh");
+ if ($master_sh)
+ {
+ if ( IS_WIN32PERL )
+ {
+ $tinfo->{'skip'}= 1;
+ $tinfo->{'comment'}= "No tests with sh scripts on Windows";
+ return $tinfo;
+ }
+ else
+ {
+ $tinfo->{'master_sh'}= $master_sh;
+ }
+ }
+
+ # ----------------------------------------------------------------------
+ # slave sh
+ # ----------------------------------------------------------------------
+ my $slave_sh= find_file_in_dirs($tinfo, tdir => "$tname-slave.sh");
+ if ($slave_sh)
+ {
+ if ( IS_WIN32PERL )
+ {
+ $tinfo->{'skip'}= 1;
+ $tinfo->{'comment'}= "No tests with sh scripts on Windows";
+ return $tinfo;
+ }
+ else
+ {
+ $tinfo->{'slave_sh'}= $slave_sh;
+ }
+ }
+
+ my ($master_opts, $slave_opts)= tags_from_test_file($tinfo);
+ $tinfo->{in_overlay} = 1 if $file_in_overlay{$filename};
+
+ if ( $tinfo->{'big_test'} and ! $::opt_big_test )
+ {
+ $tinfo->{'skip'}= 1;
+ $tinfo->{'comment'}= "Test needs --big-test";
+ return $tinfo
+ }
+
+ if ( $tinfo->{'big_test'} )
+ {
+ # All 'big_test' takes a long time to run
+ $tinfo->{'long_test'}= 1;
+ }
+
+ if ( ! $tinfo->{'big_test'} and $::opt_big_test > 1 )
+ {
+ $tinfo->{'skip'}= 1;
+ $tinfo->{'comment'}= "Small test";
+ return $tinfo
+ }
+
+ if ( $tinfo->{'rpl_test'} )
+ {
+ if ( $skip_rpl )
+ {
+ $tinfo->{'skip'}= 1;
+ $tinfo->{'comment'}= "No replication tests";
+ return $tinfo;
+ }
+ }
+
+ # ----------------------------------------------------------------------
+ # Find config file to use if not already selected in <testname>.opt file
+ # ----------------------------------------------------------------------
+ if (not $tinfo->{template_path} )
+ {
+ my $config= find_file_in_dirs($tinfo, dir => 'my.cnf');
+ if (not $config)
+ {
+ # Suite has no config, autodetect which one to use
+ if ($tinfo->{rpl_test}) {
+ $config= "suite/rpl/my.cnf";
+ } else {
+ $config= "include/default_my.cnf";
+ }
+ }
+ $tinfo->{template_path}= $config;
+ }
+
+ # ----------------------------------------------------------------------
+ # Append mysqld extra options to master and slave, as appropriate
+ # ----------------------------------------------------------------------
+ push @{$tinfo->{'master_opt'}}, @$master_opts, @::opt_extra_mysqld_opt;
+ push @{$tinfo->{'slave_opt'}}, @$slave_opts, @::opt_extra_mysqld_opt;
+
+ process_opts($tinfo, 'master_opt');
+ process_opts($tinfo, 'slave_opt');
+
+ my @cases = ($tinfo);
+ for my $comb ($suite->{combinations}, @{$file_combinations{$filename}})
+ {
+ @cases = map make_combinations($_, \%test_combs, @{$comb}), @cases;
+ }
+ my @no_combs = grep { $test_combs{$_} == 1 } keys %test_combs;
+ if (@no_combs) {
+ mtr_error("Could not run $name with '".(
+ join(',', sort @no_combs))."' combination(s)");
+ }
+
+ for $tinfo (@cases) {
+ #
+ # Now we find a result file for every test file. It's a bit complicated.
+ # For a test foobar.test in the combination pair {aa,bb}, and in the
+ # overlay "rty" to the suite "qwe", in other words, for the
+ # that that mtr prints as
+ # ...
+ # qwe-rty.foobar 'aa,bb' [ pass ]
+ # ...
+ # the result can be expected in
+ # * either .rdiff or .result file
+ # * either in the overlay or in the original suite
+ # * with or without combinations in the file name.
+ # which means any of the following 15 file names can be used:
+ #
+ # 1 rty/r/foo,aa,bb.result
+ # 2 rty/r/foo,aa,bb.rdiff
+ # 3 qwe/r/foo,aa,bb.result
+ # 4 qwe/r/foo,aa,bb.rdiff
+ # 5 rty/r/foo,aa.result
+ # 6 rty/r/foo,aa.rdiff
+ # 7 qwe/r/foo,aa.result
+ # 8 qwe/r/foo,aa.rdiff
+ # 9 rty/r/foo,bb.result
+ # 10 rty/r/foo,bb.rdiff
+ # 11 qwe/r/foo,bb.result
+ # 12 qwe/r/foo,bb.rdiff
+ # 13 rty/r/foo.result
+ # 14 rty/r/foo.rdiff
+ # 15 qwe/r/foo.result
+ #
+ # They are listed, precisely, in the order of preference.
+ # mtr will walk that list from top to bottom and the first file that
+ # is found will be used.
+ #
+ # If this found file is a .rdiff, mtr continues walking down the list
+ # until the first .result file is found.
+ # A .rdiff is applied to that .result.
+ #
+ my $re ='';
+
+ if ($tinfo->{combinations}) {
+ $re = '(?:' . join('|', @{$tinfo->{combinations}}) . ')';
+ }
+ my $resdirglob = $suite->{rdir};
+ $resdirglob.= ',' . $suite->{parent}->{rdir} if $suite->{parent};
+
+ my %files;
+ for (<{$resdirglob}/$tname*.{rdiff,result}>) {
+ my ($path, $combs, $ext) =
+ m@^(.*)/$tname((?:,$re)*)\.(rdiff|result)$@ or next;
+ my @combs = sort split /,/, $combs;
+ $files{$_} = join '~', ( # sort files by
+ 99 - scalar(@combs), # number of combinations DESC
+ join(',', sort @combs), # combination names ASC
+ $path eq $suite->{rdir} ? 1 : 2, # overlay first
+ $ext eq 'result' ? 1 : 2 # result before rdiff
+ );
+ }
+ my @results = sort { $files{$a} cmp $files{$b} } keys %files;
+
+ if (@results) {
+ my $result_file = shift @results;
+ $tinfo->{result_file} = $result_file;
+
+ if ($result_file =~ /\.rdiff$/) {
+ shift @results while $results[0] =~ /\.rdiff$/;
+ mtr_error ("$result_file has no corresponding .result file")
+ unless @results;
+ $tinfo->{base_result} = $results[0];
+
+ if (not $::exe_patch) {
+ $tinfo->{skip} = 1;
+ $tinfo->{comment} = "requires patch executable";
+ }
+ }
+ } else {
+ # No .result file exist
+ # Remember the path where it should be
+ # saved in case of --record
+ $tinfo->{record_file}= $suite->{rdir} . "/$tname.result";
+ }
+ }
+
+ return @cases;
+}
+
+
+my $tags_map= {'big_test' => ['big_test', 1],
+ 'master-slave' => ['rpl_test', 1],
+ 'long_test' => ['long_test', 1],
+};
+my $tags_regex_string= join('|', keys %$tags_map);
+my $tags_regex= qr:include/($tags_regex_string)\.inc:o;
+
+# Get various tags from a file, recursively scanning also included files.
+# And get options from .opt file, also recursively for included files.
+# Return a list of [TAG_TO_SET, VALUE_TO_SET_TO] of found tags.
+# Also returns lists of options for master and slave found in .opt files.
+# Each include file is scanned only once, and subsequent calls just look up the
+# cached result.
+# We need to be a bit careful about speed here; previous version of this code
+# took forever to scan the full test suite.
+sub get_tags_from_file($$) {
+ my ($file, $suite)= @_;
+
+ return @{$file_to_tags{$file}} if exists $file_to_tags{$file};
+
+ my $F= IO::File->new($file)
+ or mtr_error("can't open file \"$file\": $!");
+
+ my $tags= [];
+ my $master_opts= [];
+ my $slave_opts= [];
+ my @combinations;
+
+ my $over = defined $suite->{parent};
+ my $sdir = $suite->{dir};
+ my $pdir = $suite->{parent}->{dir} if $over;
+ my $in_overlay = 0;
+ my $suffix = $file;
+ my @prefix = ('');
+
+ # to be able to look up all auxillary files in the overlay
+ # we split the file path in a prefix and a suffix
+ if ($file =~ m@^$sdir/(.*)$@) {
+ $suffix = $1;
+ @prefix = ("$sdir/");
+ push @prefix, "$pdir/" if $over;
+ $in_overlay = $over;
+ } elsif ($over and $file =~ m@^$pdir/(.*)$@) {
+ $suffix = $1;
+ @prefix = map { "$_/" } $sdir, $pdir;
+ } else {
+ $over = 0; # file neither in $sdir nor in $pdir
+ }
+
+ while (my $line= <$F>)
+ {
+ # Ignore comments.
+ next if $line =~ /^\#/;
+
+ # Add any tag we find.
+ if ($line =~ /$tags_regex/o)
+ {
+ my $to_set= $tags_map->{$1};
+ for (my $i= 0; $i < @$to_set; $i+= 2)
+ {
+ push @$tags, [$to_set->[$i], $to_set->[$i+1]];
+ }
+ }
+
+ # Check for a sourced include file.
+ if ($line =~ /^[[:space:]]*(--)?[[:space:]]*source[[:space:]]+([^;[:space:]]+)/)
+ {
+ my $include= $2;
+ # The rules below must match open_file() function of mysqltest.cc
+ # Note that for the purpose of tag collection we ignore
+ # non-existing files, and let mysqltest handle the error
+ # (e.g. mysqltest.test needs this)
+ for ((map { dirname("$_$suffix") } @prefix),
+ $sdir, $pdir, $::glob_mysql_test_dir)
+ {
+ next unless defined $_;
+ my $sourced_file = "$_/$include";
+ next if $sourced_file eq $file;
+ if (-e $sourced_file)
+ {
+ push @$tags, get_tags_from_file($sourced_file, $suite);
+ push @$master_opts, @{$file_to_master_opts{$sourced_file}};
+ push @$slave_opts, @{$file_to_slave_opts{$sourced_file}};
+ push @combinations, @{$file_combinations{$sourced_file}};
+ $file_in_overlay{$file} ||= $file_in_overlay{$sourced_file};
+ last;
+ }
+ }
+ }
+ }
+
+ # Add options from main file _after_ those of any includes; this allows a
+ # test file to override options set by includes (eg. rpl.rpl_ddl uses this
+ # to enable innodb, then disable innodb in the slave.
+ $suffix =~ s/\.\w+$//;
+
+ for (qw(.opt -master.opt -slave.opt)) {
+ my @res;
+ push @res, opts_from_file("$prefix[1]$suffix$_") if $over;
+ if (-f "$prefix[0]$suffix$_") {
+ $in_overlay = $over;
+ push @res, opts_from_file("$prefix[0]$suffix$_");
+ }
+ push @$master_opts, @res unless /slave/;
+ push @$slave_opts, @res unless /master/;
+ }
+
+ # for combinations we need to make sure that its suite object is loaded,
+ # even if this file does not belong to a current suite!
+ my $comb_file = "$suffix.combinations";
+ $suite = load_suite_object(suite_for_file($comb_file)) if $prefix[0] eq '';
+ my @comb;
+ unless ($suite->{skip}) {
+ my $from = "$prefix[0]$comb_file";
+ @comb = combinations_from_file($over, $from);
+ push @comb,
+ grep { not $skip_combinations{"$from => $_->{name}"} }
+ combinations_from_file(undef, "$prefix[1]$comb_file") if $over;
+ }
+ push @combinations, [ @comb ];
+
+ # Save results so we can reuse without parsing if seen again.
+ $file_to_tags{$file}= $tags;
+ $file_to_master_opts{$file}= $master_opts;
+ $file_to_slave_opts{$file}= $slave_opts;
+ $file_combinations{$file}= [ ::uniq(@combinations) ];
+ $file_in_overlay{$file} = 1 if $in_overlay;
+
+ return @{$tags};
+}
+
+sub tags_from_test_file {
+ my ($tinfo)= @_;
+ my $file = $tinfo->{path};
+
+ # a suite may generate tests that don't map to real *.test files
+ # see unit suite for an example.
+ return ([], []) unless -f $file;
+
+ for (get_tags_from_file($file, $tinfo->{suite}))
+ {
+ $tinfo->{$_->[0]}= $_->[1];
+ }
+ return ($file_to_master_opts{$file}, $file_to_slave_opts{$file});
+}
+
+sub unspace {
+ my $string= shift;
+ my $quote= shift;
+ $string =~ s/[ \t]/\x11/g;
+ return "$quote$string$quote";
+}
+
+
+sub opts_from_file ($) {
+ my $file= shift;
+ local $_;
+
+ return () unless -f $file;
+
+ open(FILE, '<', $file) or mtr_error("can't open file \"$file\": $!");
+ my @args;
+ while ( <FILE> )
+ {
+ chomp;
+
+ # --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.
+
+ s/\'([^\'\"]*)\'/unspace($1,"\x0a")/ge;
+ s/\"([^\'\"]*)\"/unspace($1,"\x0b")/ge;
+ s/\'([^\'\"]*)\'/unspace($1,"\x0a")/ge;
+ s/\"([^\'\"]*)\"/unspace($1,"\x0b")/ge;
+
+ 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;
+
+ # Do not pass empty string since my_getopt is not capable to handle it.
+ if (length($arg)) {
+ push(@args, $arg);
+ }
+ }
+ }
+ close FILE;
+ return @args;
+}
+
+1;
+
diff --git a/mysql-test/lib/mtr_gprof.pl b/mysql-test/lib/mtr_gprof.pl
new file mode 100644
index 00000000..eb440e48
--- /dev/null
+++ b/mysql-test/lib/mtr_gprof.pl
@@ -0,0 +1,41 @@
+# -*- cperl -*-
+# Copyright (c) 2004, 2011, Oracle and/or its affiliates
+#
+# 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-1335 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 gprof_collect ($@) {
+ my ($exe_mysqld, @gprof_dirs)= @_;
+
+ print ("Collecting gprof reports.....\n");
+
+ foreach my $datadir (@gprof_dirs)
+ {
+ my $gprof_msg= "$datadir/gprof.msg";
+ my $gprof_err= "$datadir/gprof.err";
+ if ( -f "$datadir/gmon.out" )
+ {
+ system("gprof $exe_mysqld $datadir/gmon.out 2>$gprof_err >$gprof_msg");
+ print ("GPROF output in $gprof_msg, errors in $gprof_err\n");
+ }
+ }
+}
+
+
+1;
diff --git a/mysql-test/lib/mtr_io.pl b/mysql-test/lib/mtr_io.pl
new file mode 100644
index 00000000..0010c162
--- /dev/null
+++ b/mysql-test/lib/mtr_io.pl
@@ -0,0 +1,112 @@
+# -*- cperl -*-
+# Copyright (c) 2004-2008 MySQL AB, 2008 Sun Microsystems, Inc.
+# Use is subject to license terms.
+#
+# 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-1335 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 Carp;
+use My::Platform;
+
+sub mtr_fromfile ($);
+sub mtr_tofile ($@);
+sub mtr_tonewfile($@);
+sub mtr_appendfile_to_file ($$);
+sub mtr_grab_file($);
+sub mtr_printfile($);
+sub mtr_lastlinesfromfile ($$);
+
+# 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_tofile ($@) {
+ my $file= shift;
+ my $fh= open_for_append $file;
+ mtr_error("can't open file \"$file\": $!") unless defined($fh);
+ print $fh join("", @_);
+ close $fh;
+}
+
+
+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;
+}
+
+
+# Print the file to STDOUT
+sub mtr_printfile($) {
+ my $file= shift;
+ open(FILE, '<', $file)
+ or warn $!;
+ print while(<FILE>);
+ close FILE;
+ return;
+}
+
+sub mtr_lastlinesfromfile ($$) {
+ croak "usage: mtr_lastlinesfromfile(file,numlines)" unless (@_ == 2);
+ my ($file, $num_lines)= @_;
+ my $text;
+ open(FILE,"<",$file) or mtr_error("can't open file \"$file\": $!");
+ my @lines= reverse <FILE>;
+ close FILE;
+ my $size= scalar(@lines);
+ $num_lines= $size unless ($size >= $num_lines);
+ return join("", reverse(splice(@lines, 0, $num_lines)));
+}
+
+1;
diff --git a/mysql-test/lib/mtr_match.pm b/mysql-test/lib/mtr_match.pm
new file mode 100644
index 00000000..73cdb3bd
--- /dev/null
+++ b/mysql-test/lib/mtr_match.pm
@@ -0,0 +1,98 @@
+# -*- cperl -*-
+# Copyright (C) 2004-2008 MySQL AB
+# Use is subject to license terms
+#
+# 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-1335 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.
+
+package mtr_match;
+use strict;
+
+use base qw(Exporter);
+our @EXPORT= qw(mtr_match_prefix
+ mtr_match_extension
+ mtr_match_substring);
+
+#
+# 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;
diff --git a/mysql-test/lib/mtr_misc.pl b/mysql-test/lib/mtr_misc.pl
new file mode 100644
index 00000000..24085f54
--- /dev/null
+++ b/mysql-test/lib/mtr_misc.pl
@@ -0,0 +1,361 @@
+# -*- cperl -*-
+# Copyright (c) 2004, 2011, Oracle and/or its affiliates.
+# Copyright (c) 2009-2011, Monty Program Ab
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU Library 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
+# Library 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-1335 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 My::Platform;
+
+sub mtr_init_args ($);
+sub mtr_add_arg ($$@);
+sub mtr_args2str($@);
+sub mtr_path_exists(@);
+sub mtr_script_exists(@);
+sub mtr_file_exists(@);
+sub mtr_exe_exists(@);
+sub mtr_exe_maybe_exists(@);
+sub mtr_compress_file($);
+sub mtr_milli_sleep($);
+sub start_timer($);
+sub has_expired($);
+sub init_timers();
+sub mark_time_used($);
+sub mark_time_idle();
+sub add_total_times($);
+sub print_times_used($$);
+sub print_total_times($);
+
+our $opt_report_times;
+
+##############################################################################
+#
+# Args
+#
+##############################################################################
+
+sub mtr_init_args ($) {
+ my $args = shift;
+ $$args = []; # Empty list
+}
+
+sub mtr_add_arg ($$@) {
+ my $args= shift;
+ my $format= shift;
+ my @fargs = @_;
+
+ # Quote args if args contain space
+ $format= "\"$format\""
+ if (IS_WINDOWS and grep(/\s/, @fargs));
+
+ push(@$args, sprintf($format, @fargs));
+}
+
+sub mtr_args2str($@) {
+ my $exe= shift or die;
+ return join(" ", native_path($exe), @_);
+}
+
+##############################################################################
+
+#
+# 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(IS_WINDOWS)
+ {
+ 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 IS_WINDOWS;
+ foreach my $path ( @path )
+ {
+ if(IS_WINDOWS)
+ {
+ return $path if -f $path;
+ }
+ else
+ {
+ return $path if -x $path;
+ }
+ }
+ return "";
+}
+
+
+#
+# NOTE! More specific paths should be given before less specific.
+#
+sub mtr_pl_maybe_exists (@) {
+ my @path= @_;
+
+ map {$_.= ".pl"} @path if IS_WINDOWS;
+ foreach my $path ( @path )
+ {
+ if(IS_WINDOWS)
+ {
+ 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));
+ }
+}
+
+#
+# Try to compress file using tools that might be available.
+# If zip/gzip is not available, just silently ignore.
+#
+
+sub mtr_compress_file ($) {
+ my ($filename)= @_;
+
+ mtr_error ("File to compress not found: $filename") unless -f $filename;
+
+ my $did_compress= 0;
+
+ if (IS_WINDOWS)
+ {
+ # Capture stderr
+ my $ziperr= `zip $filename.zip $filename 2>&1`;
+ if ($?) {
+ print "$ziperr\n" if $ziperr !~ /recognized as an internal or external/;
+ } else {
+ unlink($filename);
+ $did_compress=1;
+ }
+ }
+ else
+ {
+ my $gzres= system("gzip $filename");
+ $did_compress= ! $gzres;
+ if ($gzres && $gzres != -1) {
+ mtr_error ("Error: have gzip but it fails to compress core file");
+ }
+ }
+ mtr_print("Compressed file $filename") if $did_compress;
+}
+
+
+sub mtr_milli_sleep ($) {
+ die "usage: mtr_milli_sleep(milliseconds)" unless @_ == 1;
+ my ($millis)= @_;
+
+ select(undef, undef, undef, ($millis/1000));
+}
+
+sub mtr_wait_lock_file {
+ die "usage: mtr_wait_lock_file(path_to_file, keep_alive)" unless @_ == 2;
+ my ($file, $keep_alive)= @_;
+ my $waited= 0;
+ my $msg_counter= $keep_alive;
+
+ while ( -e $file)
+ {
+ if ($keep_alive && !$msg_counter)
+ {
+ print "\n-STOPPED- [pass] ".$keep_alive."\n";
+ $msg_counter= $keep_alive;
+ }
+ mtr_milli_sleep(1000);
+ $waited= 1;
+ $msg_counter--;
+ }
+ return ($waited);
+}
+
+sub uniq(@) {
+ my %seen = map { $_ => $_ } @_;
+ values %seen;
+}
+
+# Simple functions to start and check timers (have to be actively polled)
+# Timer can be "killed" by setting it to 0
+
+sub start_timer ($) { return time + $_[0]; }
+
+sub has_expired ($) { return $_[0] && time gt $_[0]; }
+
+# Below code is for time usage reporting
+
+use Time::HiRes qw(gettimeofday);
+
+my %time_used= (
+ 'collect' => 0,
+ 'restart' => 0,
+ 'check' => 0,
+ 'ch-warn' => 0,
+ 'test' => 0,
+ 'init' => 0,
+ 'admin' => 0,
+);
+
+my %time_text= (
+ 'collect' => "Collecting test cases",
+ 'restart' => "Server stop/start",
+ 'check' => "Check-testcase",
+ 'ch-warn' => "Check for warnings",
+ 'test' => "Test execution",
+ 'init' => "Initialization/cleanup",
+ 'admin' => "Test administration",
+);
+
+# Counts number of reports from workers
+
+my $time_totals= 0;
+
+my $last_timer_set;
+
+sub init_timers() {
+ $last_timer_set= gettimeofday();
+}
+
+sub mark_time_used($) {
+ my ($name)= @_;
+ return unless $opt_report_times;
+ die "Unknown timer $name" unless exists $time_used{$name};
+
+ my $curr_time= gettimeofday();
+ $time_used{$name}+= int (($curr_time - $last_timer_set) * 1000 + .5);
+ $last_timer_set= $curr_time;
+}
+
+sub mark_time_idle() {
+ $last_timer_set= gettimeofday() if $opt_report_times;
+}
+
+sub add_total_times($) {
+ my ($dummy, $num, @line)= split (" ", $_[0]);
+
+ $time_totals++;
+ foreach my $elem (@line) {
+ my ($name, $spent)= split (":", $elem);
+ $time_used{$name}+= $spent;
+ }
+}
+
+sub print_times_used($$) {
+ my ($server, $num)= @_;
+ return unless $opt_report_times;
+
+ my $output= "SPENT $num";
+ foreach my $name (keys %time_used) {
+ my $spent= $time_used{$name};
+ $output.= " $name:$spent";
+ }
+ print $server $output . "\n";
+}
+
+sub print_total_times($) {
+ # Don't print if we haven't received all worker data
+ return if $time_totals != $_[0];
+
+ foreach my $name (keys %time_used)
+ {
+ my $spent= $time_used{$name}/1000;
+ my $text= $time_text{$name};
+ print ("Spent $spent seconds on $text\n");
+ }
+}
+
+
+1;
diff --git a/mysql-test/lib/mtr_process.pl b/mysql-test/lib/mtr_process.pl
new file mode 100644
index 00000000..6e2ada46
--- /dev/null
+++ b/mysql-test/lib/mtr_process.pl
@@ -0,0 +1,154 @@
+# -*- cperl -*-
+# Copyright (c) 2004, 2010, Oracle and/or its affiliates
+#
+# 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-1335 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 Socket;
+use Errno;
+use My::Platform;
+use if IS_WINDOWS, "Net::Ping";
+
+# Ancient perl might not have port_number method for Net::Ping.
+# Check it and use fallback to connect() if it is not present.
+BEGIN
+{
+ my $use_netping= 0;
+ if (IS_WINDOWS)
+ {
+ my $ping = Net::Ping->new();
+ if ($ping->can("port_number"))
+ {
+ $use_netping= 1;
+ }
+ }
+ eval 'sub USE_NETPING { $use_netping }';
+}
+
+sub sleep_until_file_created ($$$$$);
+sub mtr_ping_port ($);
+
+sub mtr_ping_port ($) {
+ my $port= shift;
+
+ mtr_verbose2("mtr_ping_port: $port");
+
+ if (IS_WINDOWS && USE_NETPING)
+ {
+ # Under Windows, connect to a port that is not open is slow
+ # It takes ~1sec. Net::Ping with small timeout is much faster.
+ my $ping = Net::Ping->new();
+ $ping->port_number($port);
+ if ($ping->ping("localhost",0.1))
+ {
+ mtr_verbose2("USED");
+ return 1;
+ }
+ else
+ {
+ mtr_verbose2("FREE");
+ return 0;
+ }
+ }
+
+ my $remote= "localhost";
+ my $iaddr= inet_aton($remote);
+ if ( ! $iaddr )
+ {
+ mtr_error("can't find IP number for $remote");
+ }
+ my $paddr= sockaddr_in($port, $iaddr);
+ my $proto= getprotobyname('tcp');
+ if ( ! socket(SOCK, PF_INET, SOCK_STREAM, $proto) )
+ {
+ mtr_error("can't create socket: $!");
+ }
+
+ mtr_debug("Pinging server (port: $port)...");
+
+ if ( connect(SOCK, $paddr) )
+ {
+ close(SOCK); # FIXME check error?
+ mtr_verbose2("USED");
+ return 1;
+ }
+ else
+ {
+ mtr_verbose2("FREE");
+ return 0;
+ }
+}
+
+##############################################################################
+#
+# Wait for a file to be created
+#
+##############################################################################
+
+# FIXME check that the pidfile contains the expected pid!
+
+sub sleep_until_file_created ($$$$$) {
+ my $pidfile= shift;
+ my $expectfile = shift;
+ my $timeout= shift;
+ my $proc= shift;
+ my $warn_seconds = shift;
+ my $sleeptime= 10; # Milliseconds
+ my $loops= ($timeout * 1000) / $sleeptime;
+ my $message_time= 60;
+
+ for ( my $loop= 0; $loop <= $loops; $loop++ )
+ {
+ if ( -r $pidfile )
+ {
+ return 1;
+ }
+
+ my $seconds= ($loop * $sleeptime) / 1000;
+
+ # Check if it died after the fork() was successful
+ if ( defined $proc and ! $proc->wait_one(0, 1) )
+ {
+ return 1 if -r $expectfile;
+ mtr_warning("Process $proc died after mysql-test-run waited $seconds " .
+ "seconds for $pidfile to be created.");
+ return 0;
+ }
+
+ mtr_debug("Sleep $sleeptime milliseconds waiting for $pidfile");
+
+ # Print extra message every $warn_seconds seconds
+ if ( $seconds >= $message_time)
+ {
+ $message_time= $message_time+60;
+ my $left= $timeout - int($seconds);
+ mtr_warning("Waited $seconds seconds for $pidfile to be created, " .
+ "still waiting for $left seconds...");
+ }
+
+ mtr_milli_sleep($sleeptime);
+
+ }
+
+ mtr_warning("Timeout after mysql-test-run waited $timeout seconds " .
+ "for the process $proc to create a pid file.");
+ return 0;
+}
+
+
+1;
diff --git a/mysql-test/lib/mtr_report.pm b/mysql-test/lib/mtr_report.pm
new file mode 100644
index 00000000..97c48c19
--- /dev/null
+++ b/mysql-test/lib/mtr_report.pm
@@ -0,0 +1,773 @@
+# -*- cperl -*-
+# Copyright (c) 2004, 2011, Oracle and/or its affiliates.
+# Copyright (c) 2009-2011, Monty Program 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-1335 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.
+
+package mtr_report;
+
+use strict;
+use Sys::Hostname;
+
+use base qw(Exporter);
+our @EXPORT= qw(report_option mtr_print_line mtr_print_thick_line
+ mtr_print_header mtr_report mtr_report_stats
+ mtr_warning mtr_error mtr_debug mtr_verbose mtr_verbose2
+ mtr_verbose_restart mtr_report_test_passed
+ mtr_report_test_skipped mtr_print
+ mtr_report_test isotime);
+
+use mtr_match;
+use My::Platform;
+use POSIX qw[ _exit ];
+use IO::Handle qw[ flush ];
+use mtr_results;
+use Term::ANSIColor;
+use English;
+
+my $tot_real_time= 0;
+my $tests_done= 0;
+my $tests_failed= 0;
+
+our $timestamp= 0;
+our $timediff= 0;
+our $name;
+our $verbose;
+# TODO: no option for that? Why is it different from $verbose?
+our $verbose_restart= 0;
+our $timer= 1;
+our $tests_total;
+
+my %color_map = qw/pass green
+ retry-pass green
+ fail red
+ retry-fail red
+ disabled bright_black
+ skipped yellow
+ reset reset/;
+
+my $set_titlebar;
+my $set_color= sub { };
+
+if (-t STDOUT) {
+ if (IS_WINDOWS) {
+ eval {
+ require Win32::Console;
+ $set_titlebar = sub { &Win32::Console::Title($_[0]);};
+ }
+ } elsif ($ENV{TERM} =~ /xterm/) {
+ $set_titlebar = sub { syswrite STDOUT, "\e]0;$_[0]\a"; };
+ $set_color = sub { syswrite STDOUT, color($color_map{$_[0]}); }
+ }
+}
+
+# On Windows, stdio does not support line buffering
+# This can make MTR output from multiple forked processes interleaved, messed up.
+# Below is DYI stdout line buffering.
+my $out_line="";
+
+# Flush buffered line
+sub flush_out {
+ print $out_line;
+ $out_line = "";
+}
+
+# Print to stdout
+sub print_out {
+ if(IS_WIN32PERL) {
+ $out_line .= $_[0];
+ # Flush buffered output on new lines.
+ if (rindex($_[0], "\n") != -1) {
+ flush_out();
+ }
+ } else {
+ print($_[0]);
+ }
+}
+
+sub titlebar_stat($) {
+
+ sub time_format($) {
+ sprintf '%d:%02d:%02d', $_[0]/3600, ($_[0]/60)%60, $_[0]%60;
+ }
+
+ $tests_done++;
+ $tests_failed++ if $_[0] =~ /fail/;
+ $tests_total++ if $_[0] =~ /retry/;
+
+ my $spent = time - $BASETIME;
+ my $left = $tests_total - $tests_done;
+
+ &$set_titlebar(sprintf "mtr: spent %s on %d tests. %s (%d tests) left, %d failed",
+ time_format($spent), $tests_done,
+ time_format($spent/$tests_done * $left), $left, $tests_failed);
+}
+
+sub report_option {
+ my ($opt, $value)= @_;
+
+ # Evaluate $opt as string to use "Getopt::Long::Callback legacy API"
+ my $opt_name = "$opt";
+
+ # Convert - to _ in option name
+ $opt_name =~ s/-/_/g;
+ no strict 'refs';
+ ${$opt_name}= $value;
+}
+
+sub _name {
+ return $name ? $name." " : undef;
+}
+
+sub _mtr_report_test_name ($) {
+ my $tinfo= shift;
+ my $tname= $tinfo->fullname();
+
+ return unless defined $verbose;
+
+ print_out _name(). _timestamp();
+ print_out (sprintf "%-40s ", $tname);
+ my $worker = $tinfo->{worker};
+ print_out "w$worker " if defined $worker;
+
+ return $tname;
+}
+
+
+sub mtr_report_test_skipped ($) {
+ my ($tinfo)= @_;
+ $tinfo->{'result'}= 'MTR_RES_SKIPPED';
+
+ mtr_report_test($tinfo);
+}
+
+
+sub mtr_report_test_passed ($) {
+ my ($tinfo)= @_;
+
+ # Save the timer value
+ my $timer_str= "";
+ if ( $timer and -f "$::opt_vardir/log/timer" )
+ {
+ $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
+ if ( $tinfo->{'result'} ){
+ mtr_warning("mtr_report_test_passed: Test result",
+ "already set to '", $tinfo->{'result'}, ",");
+ }
+
+ $tinfo->{'result'}= 'MTR_RES_PASSED';
+
+ mtr_report_test($tinfo);
+
+ resfile_global("endtime ", isotime (time));
+}
+
+
+sub mtr_report_test ($) {
+ my ($tinfo)= @_;
+ my $test_name = _mtr_report_test_name($tinfo);
+
+ my $comment= $tinfo->{'comment'};
+ my $logfile= $tinfo->{'logfile'};
+ my $warnings= $tinfo->{'warnings'};
+ my $result= $tinfo->{'result'};
+ my $retry= $tinfo->{'retries'} ? "retry-" : $tinfo->{'repeat'} ? "$tinfo->{'repeat'} " : "";
+
+ if ($result eq 'MTR_RES_FAILED'){
+
+ my $timest = format_time();
+ my $fail = "fail";
+
+ if ( @$::experimental_test_cases )
+ {
+ # Find out if this test case is an experimental one, so we can treat
+ # the failure as an expected failure instead of a regression.
+ for my $exp ( @$::experimental_test_cases ) {
+ # Include pattern match for combinations
+ if ( $exp ne $test_name && $test_name !~ /^$exp / ) {
+ # if the expression is not the name of this test case, but has
+ # an asterisk at the end, determine if the characters up to
+ # but excluding the asterisk are the same
+ if ( $exp ne "" && substr($exp, -1, 1) eq "*" ) {
+ my $nexp = substr($exp, 0, length($exp) - 1);
+ if ( substr($test_name, 0, length($nexp)) ne $nexp ) {
+ # no match, try next entry
+ next;
+ }
+ # if yes, fall through to set the exp-fail status
+ } else {
+ # no match, try next entry
+ next;
+ }
+ }
+ $fail = "exp-fail";
+ $tinfo->{exp_fail}= 1;
+ last;
+ }
+ }
+
+ if ( $warnings )
+ {
+ mtr_report("[ $retry$fail ] Found warnings/errors in server log file!");
+ mtr_report(" Test ended at $timest");
+ mtr_report($warnings);
+ return;
+ }
+ my $timeout= $tinfo->{'timeout'};
+ if ( $timeout )
+ {
+ mtr_report("[ $retry$fail ] timeout after $timeout seconds");
+ mtr_report(" Test ended at $timest");
+ mtr_report("\n$tinfo->{'comment'}");
+ return;
+ }
+ else
+ {
+ mtr_report("[ $retry$fail ]\n Test ended at $timest");
+ }
+
+ if ( $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$logfile\n");
+ }
+ if ( $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("\n$comment\n");
+ }
+
+ if ( !$logfile and !$comment )
+ {
+ # Neither this script or the test tool has recorded info
+ # about why the test has failed. Should be debugged.
+ mtr_report("\nUnknown result, neither 'comment' or 'logfile' set");
+ }
+ }
+ elsif ($result eq 'MTR_RES_SKIPPED')
+ {
+ if ( $tinfo->{'disable'} )
+ {
+ mtr_report("[ disabled ] $comment");
+ }
+ elsif ( $comment )
+ {
+ mtr_report("[ skipped ] $comment");
+ }
+ else
+ {
+ mtr_report("[ skipped ]");
+ }
+ if ( $tinfo->{'warnings'} )
+ {
+ mtr_report($tinfo->{'warnings'});
+ }
+ }
+ elsif ($result eq 'MTR_RES_PASSED')
+ {
+ my $timer_str= $tinfo->{timer} || "";
+ $tot_real_time += ($timer_str/1000);
+ mtr_report("[ ${retry}pass ] ", sprintf("%5s", $timer_str));
+
+ # Show any problems check-testcase found
+ if ( defined $tinfo->{'check'} )
+ {
+ mtr_report($tinfo->{'check'});
+ }
+ }
+}
+
+
+sub mtr_report_stats ($$$$) {
+ my $prefix= shift;
+ my $fail= shift;
+ my $tests= shift;
+ my $extra_warnings= shift;
+
+ # ----------------------------------------------------------------------
+ # Find out how we where doing
+ # ----------------------------------------------------------------------
+
+ my $tot_disabled = 0;
+ my $tot_skipped= 0;
+ my $tot_skipdetect= 0;
+ my $tot_passed= 0;
+ my $tot_failed= 0;
+ my $tot_tests= 0;
+ my $tot_restarts= 0;
+ my $found_problems= 0;
+
+ foreach my $tinfo (@$tests)
+ {
+ if ( $tinfo->{failures} )
+ {
+ # Test has failed at least one time
+ $tot_tests++;
+ $tot_failed++;
+ }
+ elsif ( $tinfo->{'result'} eq 'MTR_RES_SKIPPED' )
+ {
+ # Test was skipped (disabled not counted)
+ $tot_skipped++ unless $tinfo->{'disable'};
+ $tot_disabled++ if $tinfo->{'disable'};
+ $tot_skipdetect++ if $tinfo->{'skip_detected_by_test'};
+ }
+ elsif ( $tinfo->{'result'} eq 'MTR_RES_PASSED' )
+ {
+ # Test passed
+ $tot_tests++;
+ $tot_passed++;
+ }
+
+ if ( $tinfo->{'restarted'} )
+ {
+ # Servers was restarted
+ $tot_restarts++;
+ }
+
+ # Add counts for repeated runs, if any.
+ # Note that the last run has already been counted above.
+ my $num_repeat = $tinfo->{'repeat'} - 1;
+ if ( $num_repeat > 0 )
+ {
+ $tot_tests += $num_repeat;
+ my $rep_failed = $tinfo->{'rep_failures'} || 0;
+ $tot_failed += $rep_failed;
+ $tot_passed += $num_repeat - $rep_failed;
+ }
+
+ # Look for warnings produced by mysqltest
+ my $base_file= mtr_match_extension($tinfo->{'result_file'},
+ "result"); # Trim extension
+ my $warning_file= "$base_file.warnings";
+ if ( -f $warning_file )
+ {
+ $found_problems= 1;
+ mtr_warning("Check myqltest warnings in '$warning_file'");
+ }
+ }
+
+ # ----------------------------------------------------------------------
+ # Print out a summary report to screen
+ # ----------------------------------------------------------------------
+ print "The servers were restarted $tot_restarts times\n";
+
+ if ( $timer )
+ {
+ mtr_report("Spent", sprintf("%.3f", $tot_real_time),"of",
+ time - $BASETIME, "seconds executing testcases");
+ }
+
+ resfile_global("duration", time - $BASETIME) if $::opt_resfile;
+
+ my $warnlog= "$::opt_vardir/log/warnings";
+ if ( ! $::glob_use_running_server && !$::opt_extern && -f $warnlog)
+ {
+ mtr_warning("Got errors/warnings while running tests, please examine",
+ "'$warnlog' for details.");
+ }
+
+ print "\n";
+ # Print a list of check_testcases that failed(if any)
+ if ( $::opt_check_testcases )
+ {
+ my %check_testcases;
+
+ foreach my $tinfo (@$tests)
+ {
+ if ( defined $tinfo->{'check_testcase_failed'} )
+ {
+ $check_testcases{$tinfo->{'name'}}= 1;
+ }
+ }
+
+ if ( keys %check_testcases )
+ {
+ print "Check of testcase failed for: ";
+ print join(" ", keys %check_testcases);
+ print "\n\n";
+ }
+ }
+
+ # Print summary line prefix
+ print "$prefix: ";
+
+ # Print a list of testcases that failed
+ if ( $tot_failed != 0 )
+ {
+
+ # Print each failed test, again
+ #foreach my $test ( @$tests ){
+ # if ( $test->{failures} ) {
+ # mtr_report_test($test);
+ # }
+ #}
+
+ my $ratio= $tot_passed * 100 / $tot_tests;
+ print "Failed $tot_failed/$tot_tests tests, ";
+ printf("%.2f", $ratio);
+ print "\% were successful.\n\n";
+
+ # Print the list of test that failed in a format
+ # that can be copy pasted to rerun only failing tests
+ print "Failing test(s):";
+
+ my %seen= ();
+ foreach my $tinfo (@$tests)
+ {
+ my $tname= $tinfo->{'name'};
+ if ( ($tinfo->{failures} || $tinfo->{rep_failures}) and ! $seen{$tname})
+ {
+ print " $tname";
+ $seen{$tname}= 1;
+ }
+ }
+ print "\n\n";
+
+ # Print info about reporting the error
+ print
+ "The log files in var/log may give you some hint of what went wrong.\n\n",
+ "If you want to report this error, please read first ",
+ "the documentation\n",
+ "at http://dev.mysql.com/doc/mysql/en/mysql-test-suite.html\n\n";
+
+ }
+ else
+ {
+ print "All $tot_tests tests were successful.\n\n";
+ }
+
+ if ($::opt_xml_report) {
+ my $xml_report = "";
+ my @sorted_tests = sort {$a->{'name'} cmp $b->{'name'}} @$tests;
+ my $last_suite = "";
+ my $current_suite = "";
+ my $timest = isotime(time);
+ my %suite_totals;
+ my %suite_time;
+ my %suite_tests;
+ my %suite_failed;
+ my %suite_disabled;
+ my %suite_skipped;
+ my $host = hostname;
+ my $suiteNo = 0;
+
+ # loop through test results to count totals
+ foreach my $test ( @sorted_tests ) {
+ $current_suite = $test->{'suite'}->{'name'};
+
+ if ($test->{'timer'} eq "") {
+ $test->{'timer'} = 0;
+ }
+
+ $suite_time{$current_suite} = $suite_time{$current_suite} + $test->{'timer'};
+ $suite_tests{$current_suite} = $suite_tests{$current_suite} + 1;
+
+ if ($test->{'result'} eq "MTR_RES_FAILED") {
+ $suite_failed{$current_suite} = $suite_failed{$current_suite} + 1;
+ } elsif ($test->{'result'} eq "MTR_RES_SKIPPED" && $test->{'disable'}) {
+ $suite_disabled{$current_suite} = $suite_disabled{$current_suite} + 1;
+ } elsif ($test->{'result'} eq "MTR_RES_SKIPPED") {
+ $suite_skipped{$current_suite} = $suite_skipped{$current_suite} + 1;
+ }
+
+ $suite_totals{"all_time"} = $suite_totals{"all_time"} + $test->{'timer'};
+ }
+
+ my $all_time = sprintf("%.3f", $suite_totals{"all_time"} / 1000);
+ my $suite_time = 0;
+ my $test_time = 0;
+
+ # generate xml
+ $xml_report = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
+ $xml_report .= qq(<testsuites disabled="$tot_disabled" errors="" failures="$tot_failed" name="" tests="$tot_tests" time="$all_time">\n);
+
+ foreach my $test ( @sorted_tests ) {
+ $current_suite = $test->{'suite'}->{'name'};
+
+ if ($current_suite ne $last_suite) {
+ if ($last_suite ne "") {
+ $xml_report .= "\t</testsuite>\n";
+ $suiteNo++;
+ }
+
+ $suite_time = sprintf("%.3f", $suite_time{$current_suite} / 1000);
+ $xml_report .= qq(\t<testsuite disabled="$suite_disabled{$current_suite}" errors="" failures="$suite_failed{$current_suite}" hostname="$host" id="$suiteNo" name="$current_suite" package="" skipped="$suite_skipped{$current_suite}" tests="$suite_tests{$current_suite}" time="$suite_time" timestamp="$timest">\n);
+ $last_suite = $current_suite;
+ }
+
+ $test_time = sprintf("%.3f", $test->{timer} / 1000);
+ $test->{'name'} =~ s/$current_suite\.//;
+
+ my $combinations;
+ if (defined($test->{combinations})){
+ $combinations = join ',', sort @{$test->{combinations}};
+ } else {
+ $combinations = "";
+ }
+
+ $xml_report .= qq(\t\t<testcase assertions="" classname="$current_suite" name="$test->{'name'}" ).
+ qq(status="$test->{'result'}" time="$test_time" combinations="$combinations");
+
+ my $comment= replace_special_symbols($test->{'comment'});
+
+ if ($test->{'result'} eq "MTR_RES_FAILED") {
+ my $logcontents = $test->{'logfile-failed'} || $test->{'logfile'};
+ $logcontents= $logcontents.$test->{'warnings'}."\n";
+ # remove any double ] that would end the cdata
+ $logcontents =~ s/]]/\x{fffd}/g;
+ # replace wide characters that aren't allowed in XML 1.0
+ $logcontents =~ s/[\x00-\x08\x0B\x0C\x0E-\x1F]/\x{fffd}/g;
+
+ $xml_report .= qq(>\n\t\t\t<failure message="" type="MTR_RES_FAILED">\n<![CDATA[$logcontents]]>\n\t\t\t</failure>\n\t\t</testcase>\n);
+ } elsif ($test->{'result'} eq "MTR_RES_SKIPPED" && $test->{'disable'}) {
+ $xml_report .= qq(>\n\t\t\t<disabled message="$comment" type="MTR_RES_SKIPPED"/>\n\t\t</testcase>\n);
+ } elsif ($test->{'result'} eq "MTR_RES_SKIPPED") {
+ $xml_report .= qq(>\n\t\t\t<skipped message="$comment" type="MTR_RES_SKIPPED"/>\n\t\t</testcase>\n);
+ } else {
+ $xml_report .= " />\n";
+ }
+ }
+
+ $xml_report .= "\t</testsuite>\n</testsuites>\n";
+
+ # save to file
+ my $xml_file = $::opt_xml_report;
+
+ open (my $XML_UFILE, '>:encoding(UTF-8)', $xml_file) or die 'Cannot create file $xml_file: $!';
+ print $XML_UFILE $xml_report;
+ close $XML_UFILE or warn "File close failed!";
+ }
+
+ if (@$extra_warnings)
+ {
+ print <<MSG;
+Errors/warnings were found in logfiles during server shutdown after running the
+following sequence(s) of tests:
+MSG
+ print " $_\n" for @$extra_warnings;
+ }
+
+ print "$tot_skipped tests were skipped, ".
+ "$tot_skipdetect by the test itself.\n\n" if $tot_skipped;
+
+ if ( $tot_failed != 0 || $found_problems)
+ {
+ mtr_error("there were failing test cases");
+ }
+ elsif (@$extra_warnings)
+ {
+ mtr_error("There where errors/warnings in server logs after running test cases.");
+ }
+ elsif ($fail)
+ {
+ mtr_error("Test suite failure, see messages above for possible cause(s).");
+ }
+}
+
+
+##############################################################################
+#
+# Text formatting
+#
+##############################################################################
+
+sub mtr_print_line () {
+ print '-' x 74 . "\n";
+}
+
+sub replace_special_symbols($) {
+ my $text= shift;
+ $text =~ s/&/&#38;/g;
+ $text =~ s/'/&#39;/g;
+ $text =~ s/"/&#34;/g;
+ $text =~ s/</&lt;/g;
+ $text =~ s/>/&gt;/g;
+ return $text;
+}
+
+
+sub mtr_print_thick_line {
+ my $char= shift || '=';
+ print $char x 78 . "\n";
+}
+
+
+sub mtr_print_header ($) {
+ my ($wid) = @_;
+ print "\n";
+ printf "TEST";
+ if ($wid) {
+ print " " x 34 . "WORKER ";
+ } else {
+ print " " x 38;
+ }
+ print "RESULT ";
+ print "TIME (ms) or " if $timer;
+ print "COMMENT\n";
+ mtr_print_line();
+ print "\n";
+}
+
+
+##############################################################################
+#
+# Log and reporting functions
+#
+##############################################################################
+
+use Time::localtime;
+
+use Time::HiRes qw(gettimeofday);
+
+sub format_time {
+ my $tm= localtime();
+ return sprintf("%4d-%02d-%02d %02d:%02d:%02d",
+ $tm->year + 1900, $tm->mon+1, $tm->mday,
+ $tm->hour, $tm->min, $tm->sec);
+}
+
+my $t0= gettimeofday();
+
+sub _timestamp {
+ return "" unless $timestamp;
+
+ my $diff;
+ if ($timediff){
+ my $t1= gettimeofday();
+ my $elapsed= $t1 - $t0;
+
+ $diff= sprintf(" +%02.3f", $elapsed);
+
+ # Save current time for next lap
+ $t0= $t1;
+
+ }
+
+ my $tm= localtime();
+ return sprintf("%02d%02d%02d %2d:%02d:%02d%s ",
+ $tm->year % 100, $tm->mon+1, $tm->mday,
+ $tm->hour, $tm->min, $tm->sec, $diff);
+}
+
+# Always print message to screen
+sub mtr_print (@) {
+ print _name(). join(" ", @_). "\n";
+}
+
+
+# Print message to screen if verbose is defined
+sub mtr_report (@) {
+ if (defined $verbose)
+ {
+ my @s = split /\[ (\S+) \]/, _name() . "@_\n";
+ if (@s > 1) {
+ print_out $s[0];
+ &$set_color($s[1]);
+ print_out "[ $s[1] ]";
+ &$set_color('reset');
+ print_out $s[2];
+ titlebar_stat($s[1]) if $set_titlebar;
+ } else {
+ print_out $s[0];
+ }
+ }
+}
+
+
+# Print warning to screen
+sub mtr_warning (@) {
+ flush_out();
+ print STDERR _name(). _timestamp().
+ "mysql-test-run: WARNING: ". join(" ", @_). "\n";
+}
+
+
+# Print error to screen and then exit
+sub mtr_error (@) {
+ flush_out();
+ print STDERR _name(). _timestamp().
+ "mysql-test-run: *** ERROR: ". join(" ", @_). "\n";
+ if (IS_WINDOWS)
+ {
+ POSIX::_exit(1);
+ }
+ else
+ {
+ use Carp qw(cluck);
+ cluck "Error happened" if $verbose > 0;
+ exit(1);
+ }
+}
+
+
+sub mtr_debug (@) {
+ if ( $verbose > 2 )
+ {
+ print STDERR _name().
+ _timestamp(). "####: ". join(" ", @_). "\n";
+ }
+}
+
+
+sub mtr_verbose (@) {
+ if ( $verbose )
+ {
+ print STDERR _name(). _timestamp().
+ "> ".join(" ", @_)."\n";
+ }
+}
+
+
+sub mtr_verbose2 (@) {
+ if ( $verbose > 1 )
+ {
+ print STDERR _name(). _timestamp().
+ "> ".join(" ", @_)."\n";
+ }
+}
+
+
+sub mtr_verbose_restart (@) {
+ my ($server, @args)= @_;
+ my $proc= $server->{proc};
+ if ( $verbose_restart )
+ {
+ print STDERR _name()._timestamp().
+ "> Restart $proc - ".join(" ", @args)."\n";
+ }
+}
+
+
+# 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;
+}
+
+1;
diff --git a/mysql-test/lib/mtr_results.pm b/mysql-test/lib/mtr_results.pm
new file mode 100644
index 00000000..9438b936
--- /dev/null
+++ b/mysql-test/lib/mtr_results.pm
@@ -0,0 +1,167 @@
+# -*- 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-1335 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;
diff --git a/mysql-test/lib/mtr_stress.pl b/mysql-test/lib/mtr_stress.pl
new file mode 100644
index 00000000..cf7064cb
--- /dev/null
+++ b/mysql-test/lib/mtr_stress.pl
@@ -0,0 +1,198 @@
+# -*- cperl -*-
+# Copyright (c) 2004-2007 MySQL AB, 2009 Sun Microsystems, Inc.
+# Use is subject to license terms.
+#
+# 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-1335 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 mariadbd 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_args($args, "$::glob_mysql_test_dir/mariadb-stress-test.pl");
+ 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=1");
+
+ 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
+ My::SafeProcess->run
+ (
+ name => "stress test",
+ path => $^X,
+ args => \$args,
+ );
+
+ if ( ! $::glob_use_embedded_server )
+ {
+ stop_all_servers();
+ }
+}
+
+1;
diff --git a/mysql-test/lib/mtr_unique.pm b/mysql-test/lib/mtr_unique.pm
new file mode 100644
index 00000000..f276e6e1
--- /dev/null
+++ b/mysql-test/lib/mtr_unique.pm
@@ -0,0 +1,130 @@
+# -*- cperl -*-
+# Copyright (c) 2006, 2008 MySQL AB, 2009 Sun Microsystems, Inc.
+# Use is subject to license terms.
+#
+# 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-1335 USA
+
+package mtr_unique;
+
+use strict;
+use Fcntl ':flock';
+
+use base qw(Exporter);
+our @EXPORT= qw(mtr_get_unique_id mtr_release_unique_id);
+
+use My::Platform;
+
+sub msg {
+ # print "### unique($$) - ", join(" ", @_), "\n";
+}
+
+my $dir;
+
+if(!IS_WINDOWS)
+{
+ $dir= "/tmp/mysql-unique-ids";
+}
+else
+{
+ # Try to use machine-wide directory location for unique IDs,
+ # $ALLUSERSPROFILE . IF it is not available, fallback to $TEMP
+ # which is typically a per-user temporary directory
+ if (exists $ENV{'ALLUSERSPROFILE'} && -w $ENV{'ALLUSERSPROFILE'})
+ {
+ $dir= $ENV{'ALLUSERSPROFILE'}."/mysql-unique-ids";
+ }
+ else
+ {
+ $dir= $ENV{'TEMP'}."/mysql-unique-ids";
+ }
+}
+
+my $mtr_unique_fh = undef;
+
+END
+{
+ mtr_release_unique_id();
+}
+
+#
+# Get a unique, numerical ID in a specified range.
+#
+# If no unique ID within the specified parameters can be
+# obtained, return undef.
+#
+sub mtr_get_unique_id($$) {
+ my ($min, $max)= @_;;
+
+ msg("get $min-$max, $$");
+
+ die "Can only get one unique id per process!" if defined $mtr_unique_fh;
+
+
+ # Make sure our ID directory exists
+ if (! -d $dir)
+ {
+ # If there is a file with the reserved
+ # directory name, just delete the file.
+ if (-e $dir)
+ {
+ unlink($dir);
+ }
+
+ mkdir $dir;
+ chmod 0777, $dir;
+
+ if(! -d $dir)
+ {
+ die "can't make directory $dir";
+ }
+ }
+
+
+ my $fh;
+ for(my $id = $min; $id <= $max; $id++)
+ {
+ open( $fh, ">$dir/$id");
+ chmod 0666, "$dir/$id";
+ # Try to lock the file exclusively. If lock succeeds, we're done.
+ if (flock($fh, LOCK_EX|LOCK_NB))
+ {
+ # Store file handle - we would need it to release the ID (==unlock the file)
+ $mtr_unique_fh = $fh;
+ return $id;
+ }
+ else
+ {
+ close $fh;
+ }
+ }
+ return undef;
+}
+
+
+#
+# Release a unique ID.
+#
+sub mtr_release_unique_id()
+{
+ msg("release $$");
+ if (defined $mtr_unique_fh)
+ {
+ close $mtr_unique_fh;
+ $mtr_unique_fh = undef;
+ }
+}
+
+
+1;
+
diff --git a/mysql-test/lib/openssl.cnf b/mysql-test/lib/openssl.cnf
new file mode 100644
index 00000000..7cd6f748
--- /dev/null
+++ b/mysql-test/lib/openssl.cnf
@@ -0,0 +1,12 @@
+# Toplevel section for openssl (including libssl)
+openssl_conf = default_conf_section
+
+[default_conf_section]
+# We only specify configuration for the "ssl module"
+ssl_conf = ssl_section
+
+[ssl_section]
+system_default = system_default_section
+
+[system_default_section]
+CipherString = ALL:@SECLEVEL=0
diff --git a/mysql-test/lib/process-purecov-annotations.pl b/mysql-test/lib/process-purecov-annotations.pl
new file mode 100755
index 00000000..4381aae4
--- /dev/null
+++ b/mysql-test/lib/process-purecov-annotations.pl
@@ -0,0 +1,63 @@
+#!/usr/bin/env perl
+# -*- cperl -*-
+
+# This script processes a .gcov coverage report to honor purecov
+# annotations: lines marked as inspected or as deadcode are changed
+# from looking like lines with code that was never executed to look
+# like lines that have no executable code.
+
+use strict;
+use warnings;
+
+foreach my $in_file_name ( @ARGV )
+{
+ my $out_file_name=$in_file_name . ".tmp";
+ my $skipping=0;
+
+ open(IN, "<", $in_file_name) || next;
+ open(OUT, ">", $out_file_name);
+ while(<IN>)
+ {
+ my $line= $_;
+ my $check= $line;
+
+ # process purecov: start/end multi-blocks
+ my $started=0;
+ my $ended= 0;
+ while (($started=($check =~ s/purecov: *begin *(deadcode|inspected)//)) ||
+ ($ended=($check =~ s/purecov: *end//)))
+ {
+ $skipping= $skipping + $started - $ended;
+ }
+ if ($skipping < 0)
+ {
+ print OUT "WARNING: #####: incorrect order of purecov begin/end annotations\n";
+ $skipping= 0;
+ }
+
+ # Besides purecov annotations, also remove uncovered code mark from cases
+ # like the following:
+ #
+ # -: 211:*/
+ # -: 212:class Field_value : public Value_dep
+ # #####: 213:{
+ # -: 214:public:
+ #
+ # I have no idea why would gcov think there is uncovered code there
+ #
+ my @arr= split(/:/, $line);
+ if ($skipping || $line =~ /purecov: *(inspected|deadcode)/ ||
+ $arr[2] =~ m/^{ *$/)
+ {
+ # Change '####' to '-'.
+ $arr[0] =~ s/#####/ -/g;
+ $line= join(":", @arr);
+ }
+ print OUT $line;
+ }
+ close(IN);
+ close(OUT);
+ system("mv", "-f", $out_file_name, $in_file_name);
+}
+
+
diff --git a/mysql-test/lib/t/Base.t b/mysql-test/lib/t/Base.t
new file mode 100644
index 00000000..d31670af
--- /dev/null
+++ b/mysql-test/lib/t/Base.t
@@ -0,0 +1,44 @@
+# -*- cperl -*-
+
+# Copyright (c) 2007 MySQL AB
+# Use is subject to license terms.
+#
+# 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-1335 USA
+
+use Test::More qw(no_plan);
+use strict;
+
+use_ok ("My::SafeProcess::Base");
+
+
+my $count= 0;
+for (1..100){
+ my $pid= My::SafeProcess::Base::_safe_fork();
+ exit unless $pid;
+ (waitpid($pid, 0) == $pid) and $count++;
+}
+ok($count == 100, "safe_fork");
+
+# A nice little forkbomb
+SKIP: {
+ skip("forkbomb", 1);
+ eval {
+ while(1){
+ my $pid= My::SafeProcess::Base::_safe_fork();
+ exit unless $pid;
+ }
+ };
+ ok($@, "forkbomb");
+}
+
diff --git a/mysql-test/lib/t/Find.t b/mysql-test/lib/t/Find.t
new file mode 100644
index 00000000..e6b8f5a8
--- /dev/null
+++ b/mysql-test/lib/t/Find.t
@@ -0,0 +1,50 @@
+# -*- cperl -*-
+
+# Copyright (c) 2007 MySQL AB
+# Use is subject to license terms.
+#
+# 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-1335 USA
+
+use Test::More qw(no_plan);
+use strict;
+
+use_ok ("My::Find");
+my $basedir= "../..";
+
+print "=" x 40, "\n";
+my $mysqld_exe= my_find_bin($basedir,
+ ["sql", "bin"],
+ ["mysqld", "mysqld-debug"]);
+print "mysqld_exe: $mysqld_exe\n";
+print "=" x 40, "\n";
+my $mysql_exe= my_find_bin($basedir,
+ ["client", "bin"],
+ "mysql");
+print "mysql_exe: $mysql_exe\n";
+print "=" x 40, "\n";
+
+my $mtr_build_dir= $ENV{MTR_BUILD_DIR};
+$ENV{MTR_BUILD_DIR}= "debug";
+my $mysql_exe= my_find_bin($basedir,
+ ["client", "bin"],
+ "mysql");
+print "mysql_exe: $mysql_exe\n";
+$ENV{MTR_BUILD_DIR}= $mtr_build_dir;
+print "=" x 40, "\n";
+
+my $charset_dir= my_find_dir($basedir,
+ ["share/mysql", "sql/share", "share"],
+ "charsets");
+print "charset_dir: $charset_dir\n";
+print "=" x 40, "\n";
diff --git a/mysql-test/lib/t/Options.t b/mysql-test/lib/t/Options.t
new file mode 100644
index 00000000..d0a52e0c
--- /dev/null
+++ b/mysql-test/lib/t/Options.t
@@ -0,0 +1,130 @@
+# -*- cperl -*-
+
+# Copyright (c) 2008, 2010, 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-1335 USA
+
+use Test::More qw(no_plan);
+use strict;
+
+use_ok("My::Options");
+
+my @tests=
+(
+ [
+ ['--binlog-format=row', '--loose-skip-innodb', '--binlog-format=ms'],
+ ['--binlog-format=row', '--loose-skip-innodb', '--binlog-format=statement'],
+ ['--binlog-format=statement']
+ ],
+
+ [
+ ['--binlog-format=row', '--loose-skip-innodb', '--binlog-format=statement'],
+ ['--binlog-format=row', '--loose-skip-innodb', '--binlog-format=mixed'],
+ ['--binlog-format=mixed']
+ ],
+
+ [
+ ['--binlog-format=row', '--loose-skip-innodb', '--binlog-format=mixed'],
+ ['--binlog-format=row', '--loose-skip-innodb', '--binlog-format=statement'],
+ ['--binlog-format=statement']
+ ],
+
+ [
+ ['--binlog-format=mixed', '--loose-skip-innodb', '--binlog-format=row'],
+ ['--binlog-format=statement', '--loose-skip-innodb', '--binlog-format=row'],
+ [ ]
+ ],
+
+ [
+ ['--binlog-format=row'],
+ [ ],
+ ['--binlog-format=default']
+ ],
+
+ [
+ [ ],
+ ['--binlog-format=row'],
+ ['--binlog-format=row']
+ ],
+
+ [
+ [ ],
+ ['--max_binlog_size=1' ]
+ ],
+
+ [
+ [ ],
+ ['--max_binlog_size=default' ]
+ ],
+
+ [
+ [ ],
+ ['--max_binlog_size=1', '--binlog-format=row' ]
+ ],
+ [
+ ['--binlog-format=statement' ],
+ ['--max_binlog_size=1', '--binlog-format=row']
+ ],
+
+ [
+ [ '--binlog-format=statement' ],
+ ['--max_binlog_size=1' ]
+ ],
+
+ [
+ [ '--binlog-format=statement' ],
+ ['--max_binlog_size=1' ]
+ ],
+
+ [
+ [ '--binlog-format=statement' ],
+ ['--relay-log=/path/to/a/relay-log', '--binlog-format=row'],
+ ['--relay-log=/path/to/a/relay-log', '--binlog-format=row' ]
+ ],
+
+
+ [
+ [ '--binlog-format=statement' ],
+ ['--relay-log=/path/to/a/relay-log', '--max_binlog_size=1'],
+ ['--max_binlog_size=1', '--relay-log=/path/to/a/relay-log', '--binlog-format=default' ]
+ ],
+
+ [
+ [ '--slow-query-log=0' ],
+ [ '--slow-query-log' ],
+ [ '--slow-query-log' ]
+ ],
+
+
+);
+
+
+my $test_no= 0;
+foreach my $test (@tests){
+ print "test", $test_no++, "\n";
+ foreach my $opts (@$test){
+ print My::Options::toStr("", @$opts);
+ }
+ my $from= $test->[0];
+ my $to= $test->[1];
+ my @result= My::Options::diff($from, $to);
+ ok(My::Options::same(\@result, $test->[2]));
+ if (!My::Options::same(\@result, $test->[2])){
+ print "failed\n";
+ print My::Options::toStr("result", @result);
+ print My::Options::toStr("expect", @{$test->[2]});
+ }
+ print My::Options::toSQL(@result), "\n";
+ print "\n";
+}
diff --git a/mysql-test/lib/t/Platform.t b/mysql-test/lib/t/Platform.t
new file mode 100644
index 00000000..4a9df1a5
--- /dev/null
+++ b/mysql-test/lib/t/Platform.t
@@ -0,0 +1,35 @@
+# -*- cperl -*-
+
+# Copyright (c) 2008 MySQL AB
+# Use is subject to license terms.
+#
+# 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-1335 USA
+
+use Test::More qw(no_plan);
+use strict;
+
+use_ok ("My::Platform");
+use My::Platform;
+
+use File::Temp qw / tempdir /;
+my $dir = tempdir( CLEANUP => 1 );
+
+print "Running on Windows\n" if (IS_WINDOWS);
+print "Using ActiveState perl\n" if (IS_WIN32PERL);
+print "Using cygwin perl\n" if (IS_CYGWIN);
+
+print "dir: '$dir'\n";
+print "native: '".native_path($dir)."'\n";
+print "mixed: '".mixed_path($dir)."'\n";
+print "posix: '".posix_path($dir)."'\n";
diff --git a/mysql-test/lib/t/SafeProcess.t b/mysql-test/lib/t/SafeProcess.t
new file mode 100644
index 00000000..e9f87d88
--- /dev/null
+++ b/mysql-test/lib/t/SafeProcess.t
@@ -0,0 +1,118 @@
+# -*- cperl -*-
+
+# Copyright (c) 2007 MySQL AB
+# Use is subject to license terms.
+#
+# 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-1335 USA
+
+use strict;
+use FindBin;
+use IO::File;
+
+use Test::More qw(no_plan);
+use_ok ("My::SafeProcess");
+
+
+my $perl_path= $^X;
+
+{
+ # Test exit codes
+ my $count= 32;
+ my $ok_count= 0;
+ for my $code (0..$count-1) {
+
+ my $args= [ "$FindBin::Bin/test_child.pl", "--exit-code=$code" ];
+ my $proc= My::SafeProcess->new
+ (
+ path => $perl_path,
+ args => \$args,
+ output => "/dev/null",
+ error => "/dev/null",
+ );
+ # Wait max 10 seconds for the process to finish
+ $ok_count++ if ($proc->wait_one(10) == 0 and
+ $proc->exit_status() == $code);
+ }
+ ok($count == $ok_count, "check exit_status, $ok_count");
+}
+
+
+{
+ # spawn a number of concurrent processes
+ my $count= 16;
+ my $ok_count= 0;
+ my %procs;
+ for my $code (0..$count-1) {
+
+ my $args= [ "$FindBin::Bin/test_child.pl", "--exit-code=$code" ];
+ $procs{$code}= My::SafeProcess->new
+ (
+ path => $perl_path,
+ args => \$args,
+ output => "/dev/null",
+ error => "/dev/null",
+ );
+ }
+
+ for my $code (0..$count-1) {
+ $ok_count++ if ($procs{$code}->wait_one(10) == 0 and
+ $procs{$code}->exit_status() == $code);
+ }
+ ok($count == $ok_count, "concurrent, $ok_count");
+}
+
+
+#
+# Test stdout, stderr
+#
+{
+ use File::Temp qw / tempdir /;
+ my $dir = tempdir( CLEANUP => 1 );
+
+ my $args= [ "$FindBin::Bin/test_child.pl" ];
+ my $proc= My::SafeProcess->new
+ (
+ path => $perl_path,
+ args => \$args,
+ output => "$dir/output.txt",
+ error => "$dir/error.txt",
+ );
+
+ $proc->wait_one(2); # Wait max 2 seconds for the process to finish
+
+ my $fh= IO::File->new("$dir/output.txt");
+ my @text= <$fh>;
+ ok(grep(/Hello stdout/, @text), "check stdout");
+ $fh= IO::File->new("$dir/error.txt");
+ my @text= <$fh>;
+ ok(grep(/Hello stderr/, @text), "check stderr");
+
+ # To same file
+ $proc= My::SafeProcess->new
+ (
+ path => $perl_path,
+ args => \$args,
+ output => "$dir/output.txt",
+ error => "$dir/output.txt",
+ debug => 1,
+ );
+
+ $proc->wait_one(2); # Wait max 2 seconds for the process to finish
+
+ my $fh= IO::File->new("$dir/output.txt");
+ my @text= <$fh>;
+ ok((grep(/Hello stdout/, @text) and grep(/Hello stderr/, @text)),
+ "check stdout and stderr");
+
+}
diff --git a/mysql-test/lib/t/SafeProcessStress.pl b/mysql-test/lib/t/SafeProcessStress.pl
new file mode 100755
index 00000000..352b956d
--- /dev/null
+++ b/mysql-test/lib/t/SafeProcessStress.pl
@@ -0,0 +1,165 @@
+#!/usr/bin/env perl
+# -*- cperl -*-
+
+# Copyright (c) 2007, 2008 MySQL AB
+# Use is subject to license terms.
+#
+# 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-1335 USA
+
+use strict;
+use FindBin;
+use My::SafeProcess;
+
+#
+# Test longterm running of SafeProcess
+#
+
+my $perl_path= $^X;
+my $verbose= 0;
+my $loops= 100;
+
+print "kill one and wait for one\n";
+for (1...$loops){
+ use File::Temp qw / tempdir /;
+ my $dir = tempdir( CLEANUP => 1 );
+
+ my @procs;
+ for (1..10){
+
+ my $args= [ "$FindBin::Bin/dummyd.pl", "--vardir=$dir" ];
+ my $proc= My::SafeProcess->new
+ (
+ path => $perl_path,
+ args => \$args,
+ verbose => $verbose,
+ );
+ push(@procs, $proc);
+ }
+
+ foreach my $proc (@procs) {
+ $proc->kill();
+ # dummyd will always be killed and thus
+ # exit_status should have been set to 1
+ die "oops, exit_status: ", $proc->exit_status()
+ unless $proc->exit_status() == 1;
+ }
+
+ print "=" x 60, "\n";
+}
+
+
+print "With 1 second sleep in dummyd\n";
+for (1...$loops){
+ use File::Temp qw / tempdir /;
+ my $dir = tempdir( CLEANUP => 1 );
+
+ my @procs;
+ for (1..10){
+
+ my $args= [ "$FindBin::Bin/dummyd.pl",
+ "--vardir=$dir",
+ "--sleep=1" ];
+ my $proc= My::SafeProcess->new
+ (
+ path => $perl_path,
+ args => \$args,
+ verbose => $verbose,
+ );
+ push(@procs, $proc);
+ }
+
+ foreach my $proc (@procs) {
+ $proc->kill();
+ }
+
+ print "=" x 60, "\n";
+}
+
+print "kill all and wait for one\n";
+for (1...$loops){
+ use File::Temp qw / tempdir /;
+ my $dir = tempdir( CLEANUP => 1 );
+
+ my @procs;
+ for (1..10){
+
+ my $args= [ "$FindBin::Bin/dummyd.pl", "--vardir=$dir" ];
+ my $proc= My::SafeProcess->new
+ (
+ path => $perl_path,
+ args => \$args,
+ verbose => $verbose,
+ );
+ push(@procs, $proc);
+ }
+
+ foreach my $proc (@procs) {
+ $proc->start_kill();
+ }
+
+ foreach my $proc (@procs) {
+ $proc->wait_one();
+ }
+
+ print "=" x 60, "\n";
+}
+
+print "kill all using shutdown without callback\n";
+for (1...$loops){
+ use File::Temp qw / tempdir /;
+ my $dir = tempdir( CLEANUP => 1 );
+
+ my @procs;
+ for (1..10){
+
+ my $args= [ "$FindBin::Bin/dummyd.pl", "--vardir=$dir" ];
+ my $proc= My::SafeProcess->new
+ (
+ path => $perl_path,
+ args => \$args,
+ verbose => $verbose,
+ );
+ push(@procs, $proc);
+ }
+
+ My::SafeProcess::shutdown(2, @procs);
+
+ print "=" x 60, "\n";
+}
+
+print "kill all using shutdown\n";
+for (1...$loops){
+ use File::Temp qw / tempdir /;
+ my $dir = tempdir( CLEANUP => 1 );
+
+ my @procs;
+ for (1..10){
+
+ my $args= [ "$FindBin::Bin/dummyd.pl", "--vardir=$dir" ];
+ my $proc= My::SafeProcess->new
+ (
+ path => $perl_path,
+ args => \$args,
+ verbose => $verbose,
+ shutdown => sub { }, # Does nothing
+ );
+ push(@procs, $proc);
+ }
+
+ My::SafeProcess::shutdown(2, @procs);
+
+ print "=" x 60, "\n";
+}
+
+exit(0);
diff --git a/mysql-test/lib/t/copytree.t b/mysql-test/lib/t/copytree.t
new file mode 100644
index 00000000..76a3d644
--- /dev/null
+++ b/mysql-test/lib/t/copytree.t
@@ -0,0 +1,50 @@
+#!/usr/bin/env perl
+# -*- cperl -*-
+
+# Copyright (c) 2007 MySQL AB
+# Use is subject to license terms.
+#
+# 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-1335 USA
+
+use strict;
+
+use My::File::Path;
+
+use Test::Simple tests => 7;
+use File::Temp qw / tempdir /;
+my $dir = tempdir( CLEANUP => 1 );
+my $testdir="$dir/test";
+my $test_todir="$dir/to";
+
+my $subdir= "$testdir/test1/test2/test3";
+
+#
+# 1. Create, copy and remove a directory structure
+#
+mkpath($subdir);
+ok( -d $subdir, "Check '$subdir' is created");
+
+copytree($testdir, $test_todir);
+ok( -d $test_todir, "Check '$test_todir' is created");
+ok( -d "$test_todir/test1", "Check 'test1' is created");
+ok( -d "$test_todir/test1/test2", "Check 'test2' is created");
+ok( -d "$test_todir/test1/test2/test3", "Check 'test3' is created");
+
+
+rmtree($testdir);
+ok( ! -d $testdir, "Check '$testdir' is gone");
+
+rmtree($test_todir);
+ok( ! -d $test_todir, "Check '$test_todir' is gone");
+
diff --git a/mysql-test/lib/t/dummyd.pl b/mysql-test/lib/t/dummyd.pl
new file mode 100644
index 00000000..e78648cf
--- /dev/null
+++ b/mysql-test/lib/t/dummyd.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/env perl
+# -*- cperl -*-
+
+# Copyright (c) 2007 MySQL AB
+# Use is subject to license terms.
+#
+# 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-1335 USA
+
+use strict;
+use Getopt::Long;
+use IO::File;
+
+my $vardir;
+my $randie= 0;
+my $sleep= 0;
+GetOptions
+ (
+ # Directory where to write files
+ 'vardir=s' => \$vardir,
+ 'die-randomly' => \$randie,
+ 'sleep=i' => \$sleep,
+ );
+
+die("invalid vardir ") unless defined $vardir and -d $vardir;
+
+my $pid= $$;
+while(1){
+ for my $i (1..64){
+ # Write to file
+ my $name= "$vardir/$pid.$i.tmp";
+ my $F= IO::File->new($name, "w")
+ or warn "$$, Could not open $name: $!" and next;
+ print $F rand($.) for (1..1000);
+ $F->close();
+ sleep($sleep);
+ die "ooops!" if $randie and rand() < 0.0001
+ }
+}
+
+
+exit (0);
+
+
diff --git a/mysql-test/lib/t/rmtree.t b/mysql-test/lib/t/rmtree.t
new file mode 100644
index 00000000..033bc59a
--- /dev/null
+++ b/mysql-test/lib/t/rmtree.t
@@ -0,0 +1,68 @@
+#!/usr/bin/env perl
+# -*- cperl -*-
+
+# Copyright (c) 2007 MySQL AB
+# Use is subject to license terms.
+#
+# 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-1335 USA
+
+use strict;
+
+use My::File::Path;
+
+use Test::Simple tests => 8;
+use File::Temp qw / tempdir /;
+my $dir = tempdir( CLEANUP => 1 );
+my $testdir="$dir/test";
+
+my $subdir= "$testdir/test1/test2/test3";
+
+#
+# 1. Create and remove a directory structure
+#
+mkpath($subdir);
+ok( -d $subdir, "Check '$subdir' is created");
+
+rmtree($testdir);
+ok( ! -d $testdir, "Check '$testdir' is gone");
+
+#
+# 2. Create and remove a directory structure
+# where one directory is chmod to 0000
+#
+mkpath($subdir);
+ok( -d $subdir, "Check '$subdir' is created");
+
+ok( chmod(0000, $subdir) == 1 , "Check one dir was chmoded");
+
+rmtree($testdir);
+ok( ! -d $testdir, "Check '$testdir' is gone");
+
+#
+# 3. Create and remove a directory structure
+# where one file is chmod to 0000
+#
+mkpath($subdir);
+ok( -d $subdir, "Check '$subdir' is created");
+
+my $testfile= "$subdir/test.file";
+open(F, ">", $testfile) or die;
+print F "hello\n";
+close(F);
+
+ok( chmod(0000, $testfile) == 1 , "Check one file was chmoded");
+
+rmtree($testdir);
+ok( ! -d $testdir, "Check '$testdir' is gone");
+
diff --git a/mysql-test/lib/t/testMyConfig.t b/mysql-test/lib/t/testMyConfig.t
new file mode 100755
index 00000000..99647c14
--- /dev/null
+++ b/mysql-test/lib/t/testMyConfig.t
@@ -0,0 +1,147 @@
+#!/usr/bin/env perl
+# -*- cperl -*-
+
+# Copyright (c) 2007 MySQL AB
+# Use is subject to license terms.
+#
+# 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-1335 USA
+
+use strict;
+use warnings;
+use File::Temp qw / tempdir /;
+my $dir = tempdir( CLEANUP => 1 );
+
+use Test::More qw(no_plan);
+
+BEGIN { use_ok ( "My::Config" ) };
+
+my $test_cnf= "$dir/test.cnf";
+
+# Write test config file
+open(OUT, ">", $test_cnf) or die;
+print $test_cnf, "\n";
+
+print OUT <<EOF
+[mysqld]
+# Comment
+option1=values2
+option2= value4
+option4
+basedir=thebasedir
+[mysqld_1]
+[mysqld_2]
+[mysqld.9]
+[client]
+socket =\tasocketpath
+EOF
+;
+close OUT;
+
+my $config= My::Config->new($test_cnf);
+isa_ok( $config, "My::Config" );
+
+print $config;
+
+ok ( $config->group("mysqld_2"), "group mysqld_2 exists");
+ok ( $config->group("mysqld_1"), "group mysqld_1 exists");
+ok ( $config->group("mysqld.9"), "group mysqld.9 exists");
+ok ( $config->group("mysqld.9")->suffix() eq ".9", "group mysqld.9 has suffix .9");
+
+ok ( $config->group("mysqld"), "group mysqld exists");
+ok ( $config->group("client"), "group client exists");
+ok ( !$config->group("mysqld_3"), "group mysqld_3 does not exist");
+
+ok ( $config->options_in_group("mysqld") == 4, "options in [mysqld] is 4");
+ok ( $config->options_in_group("nonexist") == 0, "options in [nonexist] is 0");
+
+{
+ my @groups= $config->groups();
+ ok(@groups == 5, "5 groups");
+ my $idx= 0;
+ foreach my $name ('mysqld', 'mysqld_1', 'mysqld_2', 'mysqld.9', 'client') {
+ is($groups[$idx++]->name(), $name, "checking groups $idx");
+ }
+}
+
+{
+ my @groups= $config->like("mysqld");
+ ok(@groups == 4, "4 groups like mysqld");
+ my $idx= 0;
+ foreach my $name ('mysqld', 'mysqld_1', 'mysqld_2', 'mysqld.9') {
+ is($groups[$idx++]->name(), $name, "checking like(\"mysqld\") $idx");
+ }
+}
+
+{
+ my @groups= $config->like("not");
+ ok(@groups == 0, "checking like(\"not\")");
+}
+
+is($config->first_like("mysqld_")->name(), "mysqld_1", "first_like");
+
+is( $config->value('mysqld', 'option4'), undef,
+ "mysqld_option4 exists, does not have a value");
+
+ok( $config->exists('mysqld', 'option4'),
+ "mysqld_option4 exists");
+ok( $config->exists('mysqld', 'option2'),
+ "mysqld_option2 exists");
+ok( !$config->exists('mysqld', 'option5'),
+ "mysqld_option5 does not exists");
+
+# Save the config to file
+my $test2_cnf= "$dir/test2.cnf";
+$config->save($test2_cnf);
+
+# read it back and check it's the same
+my $config2= My::Config->new($test2_cnf);
+isa_ok( $config2, "My::Config" );
+is_deeply( \$config, \$config2, "test.cnf is equal to test2.cnf");
+
+
+my $test_include_cnf= "$dir/test_include.cnf";
+# Write test config file that includes test.cnf
+open(OUT, ">", $test_include_cnf) or die;
+
+print OUT <<EOF
+[mysqld]
+!include test.cnf
+# Comment
+option1=values3
+basedir=anotherbasedir
+EOF
+;
+close OUT;
+
+# Read the config file
+my $config3= My::Config->new($test_include_cnf);
+isa_ok( $config3, "My::Config" );
+print $config3;
+is( $config3->value('mysqld', 'basedir'), 'anotherbasedir',
+ "mysqld_basedir has been overridden by value in test_include.cnf");
+
+is( $config3->value('mysqld', 'option1'), 'values3',
+ "mysqld_option1 has been overridden by value in test_include.cnf");
+
+is( $config3->value('mysqld', 'option2'), 'value4',
+ "mysqld_option2 is from included file");
+
+is( $config3->value('client', 'socket'), 'asocketpath',
+ "client.socket is from included file");
+
+is( $config3->value('mysqld', 'option4'), undef,
+ "mysqld_option4 exists, does not have a value");
+
+print "$config3\n";
+
diff --git a/mysql-test/lib/t/testMyConfigFactory.t b/mysql-test/lib/t/testMyConfigFactory.t
new file mode 100755
index 00000000..5ba63b3d
--- /dev/null
+++ b/mysql-test/lib/t/testMyConfigFactory.t
@@ -0,0 +1,114 @@
+#!/usr/bin/env perl
+# -*- cperl -*-
+
+# Copyright (c) 2007 MySQL AB, 2009 Sun Microsystems, Inc.
+# Use is subject to license terms.
+#
+# 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-1335 USA
+
+use strict;
+use warnings;
+
+use File::Temp qw / tempdir /;
+my $dir = tempdir( CLEANUP => 1 );
+
+use Test::More qw(no_plan);
+
+BEGIN { use_ok ( "My::ConfigFactory" ) };
+
+my $gen1_cnf= "$dir/gen1.cnf";
+open(OUT, ">", $gen1_cnf) or die;
+
+print OUT <<EOF
+[mysqld.master]
+# Comment
+option1=value1
+basedir=abasedir
+
+[mysqld.1]
+# Comment
+option1=value1
+option2=value2
+
+[ENV]
+MASTER_MY_PORT=\@mysqld.master.port
+
+EOF
+;
+close OUT;
+
+my $basedir= "../..";
+
+my $config= My::ConfigFactory->new_config
+(
+ {
+ basedir => $basedir,
+ template_path => $gen1_cnf,
+ vardir => "/path/to/var",
+ baseport => 10987,
+ #hosts => [ 'host1', 'host2' ],
+ }
+);
+
+print $config;
+
+ok ( $config->group("mysqld.master"), "group mysqld.master exists");
+ok ( $config->group("mysqld.1"), "group mysqld.1 exists");
+ok ( $config->group("client"), "group client exists");
+ok ( !$config->group("mysqld.3"), "group mysqld.3 does not exist");
+
+ok ( $config->first_like("mysqld"), "group like 'mysqld' exists");
+
+is( $config->value('mysqld.1', '#host'), 'localhost',
+ "mysqld.1.#host has been generated");
+
+is( $config->value('client', 'host'), 'localhost',
+ "client.host has been generated");
+
+is( $config->value('client', 'host'),
+ $config->value('mysqld.master', '#host'),
+ "client.host is same as mysqld.master.host");
+
+ok ( $config->value("mysqld.1", 'character-sets-dir') =~ /$basedir.*charsets$/,
+ "'character-sets-dir' generated");
+
+ok ( $config->value("mysqld.1", 'lc-messages-dir') =~ /$basedir.*share$/,
+ "'lc-messages-dir' generated");
+
+ok ( $config->value("ENV", 'MASTER_MY_PORT') =~ /\d/,
+ "'lc-messages-dir' generated");
+
+my $gen2_cnf= "$dir/gen2.cnf";
+open(OUT, ">", $gen2_cnf) or die;
+
+print OUT <<EOF
+[mysqld.master]
+EOF
+;
+close OUT;
+
+my $config2= My::ConfigFactory->new_config
+(
+ {
+ basedir => $basedir,
+ template_path => $gen2_cnf,
+ vardir => "/path/to/var",
+ baseport => 10987,
+ #hosts => [ 'host1', 'host2' ],
+ }
+);
+
+print $config2;
+
+ok ( $config2->first_like("mysqld"), "group like 'mysqld' exists");
diff --git a/mysql-test/lib/t/test_child.pl b/mysql-test/lib/t/test_child.pl
new file mode 100755
index 00000000..8a23c3d7
--- /dev/null
+++ b/mysql-test/lib/t/test_child.pl
@@ -0,0 +1,37 @@
+#!/usr/bin/env perl
+# -*- cperl -*-
+
+# Copyright (c) 2007 MySQL AB
+# Use is subject to license terms.
+#
+# 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-1335 USA
+
+use strict;
+use Getopt::Long;
+
+my $opt_exit_code= 0;
+
+GetOptions
+ (
+ # Exit with the specified exit code
+ 'exit-code=i' => \$opt_exit_code
+ );
+
+
+print "Hello stdout\n";
+print STDERR "Hello stderr\n";
+
+exit ($opt_exit_code);
+
+
diff --git a/mysql-test/lib/v1/My/Config.pm b/mysql-test/lib/v1/My/Config.pm
new file mode 100644
index 00000000..13405dc2
--- /dev/null
+++ b/mysql-test/lib/v1/My/Config.pm
@@ -0,0 +1,438 @@
+# -*- cperl -*-
+
+# Copyright (c) 2008 Sun Microsystems, Inc.
+# Use is subject to license terms.
+#
+# 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-1335 USA
+
+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;
diff --git a/mysql-test/lib/v1/incompatible.tests b/mysql-test/lib/v1/incompatible.tests
new file mode 100644
index 00000000..fefdad9c
--- /dev/null
+++ b/mysql-test/lib/v1/incompatible.tests
@@ -0,0 +1,6 @@
+# This file lists tests that cannot run in MTR v1 for some reason.
+# They will be skipped.
+# Any text following white space after full test name is ignored
+# Only exact test names can be used, no regexp.
+
+main.fulltext_plugin # Refers to $SIMPLE_PARSER_OPT which is not set
diff --git a/mysql-test/lib/v1/mtr_cases.pl b/mysql-test/lib/v1/mtr_cases.pl
new file mode 100644
index 00000000..cc190cb3
--- /dev/null
+++ b/mysql-test/lib/v1/mtr_cases.pl
@@ -0,0 +1,939 @@
+# -*- cperl -*-
+# Copyright (c) 2005, 2006 MySQL AB, 2008, 2009 Sun Microsystems, Inc.
+# Use is subject to license terms.
+#
+# 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-1335 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 File::Basename;
+use IO::File();
+use strict;
+
+use My::Config;
+
+sub collect_test_cases ($);
+sub collect_one_suite ($);
+sub collect_one_test_case ($$$$$$$$$);
+
+sub mtr_options_from_test_file($$);
+
+my $do_test;
+my $skip_test;
+my %incompatible;
+
+sub init_pattern {
+ my ($from, $what)= @_;
+ if ( $from =~ /^[a-z0-9]$/ ) {
+ # Does not contain any regex, make the pattern match
+ # beginning of string
+ $from= "^$from";
+ }
+ # Check that pattern is a valid regex
+ eval { "" =~/$from/; 1 } or
+ mtr_error("Invalid regex '$from' passed to $what\nPerl says: $@");
+ return $from;
+}
+
+
+sub collect_incomp_tests {
+ open (INCOMP, "lib/v1/incompatible.tests");
+ while (<INCOMP>)
+ {
+ next unless /^\w/;
+ s/\s.*\n//; # Ignore anything from first white space
+ $incompatible{$_}= 1;
+ }
+}
+
+##############################################################################
+#
+# Collect information about test cases we are to run
+#
+##############################################################################
+
+sub collect_test_cases ($) {
+ $do_test= init_pattern($::opt_do_test, "--do-test");
+ $skip_test= init_pattern($::opt_skip_test, "--skip-test");
+
+ collect_incomp_tests();
+
+ my $suites= shift; # Semicolon separated list of test suites
+ my $cases = []; # Array of hash
+
+ foreach my $suite (split(",", $suites))
+ {
+ push(@$cases, collect_one_suite($suite));
+ }
+
+
+ if ( @::opt_cases )
+ {
+ # Check that the tests specified was found
+ # in at least one suite
+ foreach my $test_name_spec ( @::opt_cases )
+ {
+ my $found= 0;
+ my ($sname, $tname, $extension)= split_testname($test_name_spec);
+ foreach my $test ( @$cases )
+ {
+ # test->{name} is always in suite.name format
+ if ( $test->{name} =~ /.*\.$tname/ )
+ {
+ $found= 1;
+ }
+ }
+ if ( not $found )
+ {
+ mtr_error("Could not find $tname in any suite");
+ }
+ }
+ }
+
+ if ( $::opt_reorder )
+ {
+ # Reorder the test cases in an order that will make them faster to run
+ my %sort_criteria;
+
+ # Make a mapping of test name to a string that represents how that test
+ # should be sorted among the other tests. Put the most important criterion
+ # first, then a sub-criterion, then sub-sub-criterion, et c.
+ foreach my $tinfo (@$cases)
+ {
+ my @criteria = ();
+
+ # Look for tests that muct be in run in a defined order
+ # that is defined by test having the same name except for
+ # the ending digit
+
+ # 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_verbose2("$test_name => $base_name idx=$idx");
+ if ( $idx > 1 )
+ {
+ $idx-= 1;
+ $base_name= "$base_name$idx";
+ mtr_verbose2("New basename $base_name");
+ }
+
+ foreach my $tinfo2 (@$cases)
+ {
+ if ( $tinfo2->{'name'} eq $base_name )
+ {
+ mtr_verbose2("found dependent test $tinfo2->{'name'}");
+ $depend_on_test_name=$base_name;
+ }
+ }
+ }
+
+ if ( defined $depend_on_test_name )
+ {
+ mtr_verbose2("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.
+ #
+ # Group test with equal options together.
+ # Ending with "~" makes empty sort later than filled
+ push(@criteria, join("!", sort @{$tinfo->{'master_opt'}}) . "~");
+
+ $sort_criteria{$test_name} = join(" ", @criteria);
+ }
+ }
+
+ @$cases = sort {
+ $sort_criteria{$a->{'name'}} . $a->{'name'} cmp
+ $sort_criteria{$b->{'name'}} . $b->{'name'}; } @$cases;
+
+ if ( $::opt_script_debug )
+ {
+ # For debugging the sort-order
+ foreach my $tinfo (@$cases)
+ {
+ print("$sort_criteria{$tinfo->{'name'}} -> \t$tinfo->{'name'}\n");
+ }
+ }
+ }
+
+ return $cases;
+
+}
+
+# Valid extensions and their corresonding component id
+my %exts = ( 'test' => 'mysqld',
+ 'imtest' => 'im'
+ );
+
+
+# Returns (suitename, testname, extension)
+sub split_testname {
+ my ($test_name)= @_;
+
+ # Get rid of directory part and split name on .'s
+ my @parts= split(/\./, basename($test_name));
+
+ if (@parts == 1){
+ # Only testname given, ex: alias
+ return (undef , $parts[0], undef);
+ } elsif (@parts == 2) {
+ # Either testname.test or suite.testname given
+ # Ex. main.alias or alias.test
+
+ if (defined $exts{$parts[1]})
+ {
+ return (undef , $parts[0], $parts[1]);
+ }
+ else
+ {
+ return ($parts[0], $parts[1], undef);
+ }
+
+ } elsif (@parts == 3) {
+ # Fully specified suitename.testname.test
+ # ex main.alias.test
+ return ( $parts[0], $parts[1], $parts[2]);
+ }
+
+ mtr_error("Illegal format of test name: $test_name");
+}
+
+
+sub collect_one_suite($)
+{
+ my $suite= shift; # Test suite name
+ my @cases; # Array of hash
+
+ mtr_verbose2("Collecting: $suite");
+
+ my $suitedir= "$::glob_mysql_test_dir"; # Default
+ if ( $suite ne "main" )
+ {
+ $suitedir= mtr_path_exists("$suitedir/suite/$suite",
+ "$suitedir/$suite");
+ mtr_verbose2("suitedir: $suitedir");
+ }
+
+ my $testdir= "$suitedir/t";
+ my $resdir= "$suitedir/r";
+
+ # ----------------------------------------------------------------------
+ # Build a hash of disabled testcases for this suite
+ # ----------------------------------------------------------------------
+ my %disabled;
+ if ( open(DISABLED, "$testdir/disabled.def" ) )
+ {
+ while ( <DISABLED> )
+ {
+ chomp;
+ if ( /^\s*(\S+)\s*:\s*(.*?)\s*$/ )
+ {
+ $disabled{$1}= $2;
+ }
+ }
+ close DISABLED;
+ }
+
+ # Read suite.opt file
+ my $suite_opt_file= "$testdir/suite.opt";
+ my $suite_opts= [];
+ if ( -f $suite_opt_file )
+ {
+ $suite_opts= mtr_get_opts_from_file($suite_opt_file);
+ }
+
+ if ( @::opt_cases )
+ {
+ # Collect in specified order
+ foreach my $test_name_spec ( @::opt_cases )
+ {
+ my ($sname, $tname, $extension)= split_testname($test_name_spec);
+
+ # The test name parts have now been defined
+ #print " suite_name: $sname\n";
+ #print " tname: $tname\n";
+ #print " extension: $extension\n";
+
+ # Check cirrect suite if suitename is defined
+ next if (defined $sname and $suite ne $sname);
+
+ my $component_id;
+ if ( defined $extension )
+ {
+ my $full_name= "$testdir/$tname.$extension";
+ # Extension was specified, check if the test exists
+ if ( ! -f $full_name)
+ {
+ # This is only an error if suite was specified, otherwise it
+ # could exist in another suite
+ mtr_error("Test '$full_name' was not found in suite '$sname'")
+ if $sname;
+
+ next;
+ }
+ $component_id= $exts{$extension};
+ }
+ else
+ {
+ # No extension was specified
+ my ($ext, $component);
+ while (($ext, $component)= each %exts) {
+ my $full_name= "$testdir/$tname.$ext";
+
+ if ( ! -f $full_name ) {
+ next;
+ }
+ $component_id= $component;
+ $extension= $ext;
+ }
+ # Test not found here, could exist in other suite
+ next unless $component_id;
+ }
+
+ collect_one_test_case($testdir,$resdir,$suite,$tname,
+ "$tname.$extension",\@cases,\%disabled,
+ $component_id,$suite_opts);
+ }
+ }
+ else
+ {
+ opendir(TESTDIR, $testdir) or mtr_error("Can't open dir \"$testdir\": $!");
+
+ foreach my $elem ( sort readdir(TESTDIR) )
+ {
+ my $component_id= undef;
+ my $tname= undef;
+
+ if ($tname= mtr_match_extension($elem, 'test'))
+ {
+ $component_id = 'mysqld';
+ }
+ elsif ($tname= mtr_match_extension($elem, 'imtest'))
+ {
+ $component_id = 'im';
+ }
+ else
+ {
+ next;
+ }
+
+ # Skip tests that does not match the --do-test= filter
+ next if ($do_test and not $tname =~ /$do_test/o);
+
+ collect_one_test_case($testdir,$resdir,$suite,$tname,
+ $elem,\@cases,\%disabled,$component_id,
+ $suite_opts);
+ }
+ closedir TESTDIR;
+ }
+
+
+ # Return empty list if no testcases found
+ return if (@cases == 0);
+
+ # ----------------------------------------------------------------------
+ # Read combinations for this suite and build testcases x combinations
+ # if any combinations exists
+ # ----------------------------------------------------------------------
+ if ( ! $::opt_skip_combination )
+ {
+ my @combinations;
+ my $combination_file= "$suitedir/combinations";
+ #print "combination_file: $combination_file\n";
+ if (@::opt_combinations)
+ {
+ # take the combination from command-line
+ mtr_verbose2("Take the combination from command line");
+ foreach my $combination (@::opt_combinations) {
+ my $comb= {};
+ $comb->{name}= $combination;
+ push(@{$comb->{comb_opt}}, $combination);
+ push(@combinations, $comb);
+ }
+ }
+ elsif (-f $combination_file )
+ {
+ # Read combinations file in my.cnf format
+ mtr_verbose2("Read combinations file");
+ my $config= My::Config->new($combination_file);
+
+ foreach my $group ($config->groups()) {
+ my $comb= {};
+ $comb->{name}= $group->name();
+ foreach my $option ( $group->options() ) {
+ push(@{$comb->{comb_opt}}, "--".$option->name()."=".$option->value());
+ }
+ push(@combinations, $comb);
+ }
+ }
+
+ if (@combinations)
+ {
+ print " - adding combinations\n";
+ #print_testcases(@cases);
+
+ my @new_cases;
+ foreach my $comb (@combinations)
+ {
+ foreach my $test (@cases)
+ {
+ #print $test->{name}, " ", $comb, "\n";
+ my $new_test= {};
+
+ while (my ($key, $value) = each(%$test)) {
+ if (ref $value eq "ARRAY") {
+ push(@{$new_test->{$key}}, @$value);
+ } else {
+ $new_test->{$key}= $value;
+ }
+ }
+
+ # Append the combination options to master_opt and slave_opt
+ push(@{$new_test->{master_opt}}, @{$comb->{comb_opt}});
+ push(@{$new_test->{slave_opt}}, @{$comb->{comb_opt}});
+
+ # Add combination name shrt name
+ $new_test->{combination}= $comb->{name};
+
+ # Add the new test to new test cases list
+ push(@new_cases, $new_test);
+ }
+ }
+ #print_testcases(@new_cases);
+ @cases= @new_cases;
+ #print_testcases(@cases);
+ }
+ }
+
+ optimize_cases(\@cases);
+ #print_testcases(@cases);
+
+ return @cases;
+}
+
+
+#
+# Loop through all test cases
+# - optimize which test to run by skipping unnecessary ones
+# - update settings if necessary
+#
+sub optimize_cases {
+ my ($cases)= @_;
+
+ foreach my $tinfo ( @$cases )
+ {
+ # Skip processing if already marked as skipped
+ next if $tinfo->{skip};
+
+ # =======================================================
+ # If a special binlog format was selected with
+ # --mysqld=--binlog-format=x, skip all test that does not
+ # support it
+ # =======================================================
+ #print "used_binlog_format: $::used_binlog_format\n";
+ if (defined $::used_binlog_format )
+ {
+ # =======================================================
+ # Fixed --binlog-format=x specified on command line
+ # =======================================================
+ if ( defined $tinfo->{'binlog_formats'} )
+ {
+ #print "binlog_formats: ". join(", ", @{$tinfo->{binlog_formats}})."\n";
+
+ # The test supports different binlog formats
+ # check if the selected one is ok
+ my $supported=
+ grep { $_ eq $::used_binlog_format } @{$tinfo->{'binlog_formats'}};
+ if ( !$supported )
+ {
+ $tinfo->{'skip'}= 1;
+ $tinfo->{'comment'}=
+ "Doesn't support --binlog-format='$::used_binlog_format'";
+ }
+ }
+ }
+ else
+ {
+ # =======================================================
+ # Use dynamic switching of binlog format
+ # =======================================================
+
+ # Get binlog-format used by this test from master_opt
+ my $test_binlog_format;
+ foreach my $opt ( @{$tinfo->{master_opt}} ) {
+ $test_binlog_format=
+ mtr_match_prefix($opt, "--binlog-format=") || $test_binlog_format;
+ }
+
+ if (defined $test_binlog_format and
+ defined $tinfo->{binlog_formats} )
+ {
+ my $supported=
+ grep { $_ eq $test_binlog_format } @{$tinfo->{'binlog_formats'}};
+ if ( !$supported )
+ {
+ $tinfo->{'skip'}= 1;
+ $tinfo->{'comment'}=
+ "Doesn't support --binlog-format='$test_binlog_format'";
+ next;
+ }
+ }
+ }
+
+ }
+}
+
+
+##############################################################################
+#
+# Collect information about a single test case
+#
+##############################################################################
+
+
+sub collect_one_test_case($$$$$$$$$) {
+ my $testdir= shift;
+ my $resdir= shift;
+ my $suite= shift;
+ my $tname= shift;
+ my $elem= shift;
+ my $cases= shift;
+ my $disabled=shift;
+ my $component_id= shift;
+ my $suite_opts= shift;
+
+ my $path= "$testdir/$elem";
+
+ # ----------------------------------------------------------------------
+ # Skip some tests silently
+ # ----------------------------------------------------------------------
+
+ if ( $::opt_start_from and $tname lt $::opt_start_from )
+ {
+ return;
+ }
+
+
+ my $tinfo= {};
+ $tinfo->{'name'}= basename($suite) . ".$tname";
+ $tinfo->{'result_file'}= "$resdir/$tname.result";
+ $tinfo->{'component_id'} = $component_id;
+ push(@$cases, $tinfo);
+
+ # Remove "combinations" part of test name
+ my $test_base_name= $tinfo->{'name'};
+ $test_base_name=~ s/\s.*\n//;
+
+ if (exists ($incompatible{$test_base_name}))
+ {
+ $tinfo->{'skip'}= 1;
+ $tinfo->{'comment'}= "Test cannot run in mtr v1";
+ return;
+ }
+
+ # ----------------------------------------------------------------------
+ # Skip some tests but include in list, just mark them to skip
+ # ----------------------------------------------------------------------
+
+ if ( $skip_test and $tname =~ /$skip_test/o )
+ {
+ $tinfo->{'skip'}= 1;
+ return;
+ }
+
+ # ----------------------------------------------------------------------
+ # Collect information about test case
+ # ----------------------------------------------------------------------
+
+ $tinfo->{'path'}= $path;
+ $tinfo->{'timezone'}= "GMT-3"; # for UNIX_TIMESTAMP tests to work
+
+ $tinfo->{'slave_num'}= 0; # Default, no slave
+ $tinfo->{'master_num'}= 1; # Default, 1 master
+ if ( defined mtr_match_prefix($tname,"rpl") )
+ {
+ if ( $::opt_skip_rpl )
+ {
+ $tinfo->{'skip'}= 1;
+ $tinfo->{'comment'}= "No replication tests(--skip-rpl)";
+ return;
+ }
+
+ $tinfo->{'slave_num'}= 1; # Default for rpl* tests, use one slave
+
+ }
+
+ if ( defined mtr_match_prefix($tname,"federated") )
+ {
+ # Default, federated uses the first slave as it's federated database
+ $tinfo->{'slave_num'}= 1;
+ }
+
+ my $master_opt_file= "$testdir/$tname-master.opt";
+ my $slave_opt_file= "$testdir/$tname-slave.opt";
+ my $slave_mi_file= "$testdir/$tname.slave-mi";
+ my $master_sh= "$testdir/$tname-master.sh";
+ my $slave_sh= "$testdir/$tname-slave.sh";
+ my $disabled_file= "$testdir/$tname.disabled";
+ my $im_opt_file= "$testdir/$tname-im.opt";
+
+ $tinfo->{'master_opt'}= [];
+ $tinfo->{'slave_opt'}= [];
+ $tinfo->{'slave_mi'}= [];
+
+
+ # Add suite opts
+ foreach my $opt ( @$suite_opts )
+ {
+ mtr_verbose2($opt);
+ push(@{$tinfo->{'master_opt'}}, $opt);
+ push(@{$tinfo->{'slave_opt'}}, $opt);
+ }
+
+ # Add master opts
+ if ( -f $master_opt_file )
+ {
+
+ my $master_opt= mtr_get_opts_from_file($master_opt_file);
+
+ foreach my $opt ( @$master_opt )
+ {
+ my $value;
+
+ # The opt file is used both to send special options to the mysqld
+ # as well as pass special test case specific options to this
+ # script
+
+ $value= mtr_match_prefix($opt, "--timezone=");
+ if ( defined $value )
+ {
+ $tinfo->{'timezone'}= $value;
+ next;
+ }
+
+ $value= mtr_match_prefix($opt, "--slave-num=");
+ if ( defined $value )
+ {
+ $tinfo->{'slave_num'}= $value;
+ next;
+ }
+
+ $value= mtr_match_prefix($opt, "--result-file=");
+ if ( defined $value )
+ {
+ # Specifies the file mysqltest should compare
+ # output against
+ $tinfo->{'result_file'}= "r/$value.result";
+ next;
+ }
+
+ # If we set default time zone, remove the one we have
+ $value= mtr_match_prefix($opt, "--default-time-zone=");
+ if ( defined $value )
+ {
+ # Set timezone for this test case to something different
+ $tinfo->{'timezone'}= "GMT-8";
+ # Fallthrough, add the --default-time-zone option
+ }
+
+ # The --restart option forces a restart even if no special
+ # option is set. If the options are the same as next testcase
+ # there is no need to restart after the testcase
+ # has completed
+ if ( $opt eq "--force-restart" )
+ {
+ $tinfo->{'force_restart'}= 1;
+ next;
+ }
+
+ # Ok, this was a real option, add it
+ push(@{$tinfo->{'master_opt'}}, $opt);
+ }
+ }
+
+ # Add slave opts
+ if ( -f $slave_opt_file )
+ {
+ my $slave_opt= mtr_get_opts_from_file($slave_opt_file);
+
+ foreach my $opt ( @$slave_opt )
+ {
+ # If we set default time zone, remove the one we have
+ my $value= mtr_match_prefix($opt, "--default-time-zone=");
+ $tinfo->{'slave_opt'}= [] if defined $value;
+ }
+ push(@{$tinfo->{'slave_opt'}}, @$slave_opt);
+ }
+
+ if ( -f $slave_mi_file )
+ {
+ $tinfo->{'slave_mi'}= mtr_get_opts_from_file($slave_mi_file);
+ }
+
+ if ( -f $master_sh )
+ {
+ if ( $::glob_win32_perl )
+ {
+ $tinfo->{'skip'}= 1;
+ $tinfo->{'comment'}= "No tests with sh scripts on Windows";
+ return;
+ }
+ else
+ {
+ $tinfo->{'master_sh'}= $master_sh;
+ }
+ }
+
+ if ( -f $slave_sh )
+ {
+ if ( $::glob_win32_perl )
+ {
+ $tinfo->{'skip'}= 1;
+ $tinfo->{'comment'}= "No tests with sh scripts on Windows";
+ return;
+ }
+ else
+ {
+ $tinfo->{'slave_sh'}= $slave_sh;
+ }
+ }
+
+ if ( -f $im_opt_file )
+ {
+ $tinfo->{'im_opts'} = mtr_get_opts_from_file($im_opt_file);
+ }
+ else
+ {
+ $tinfo->{'im_opts'} = [];
+ }
+
+ # FIXME why this late?
+ my $marked_as_disabled= 0;
+ if ( $disabled->{$tname} )
+ {
+ $marked_as_disabled= 1;
+ $tinfo->{'comment'}= $disabled->{$tname};
+ }
+
+ if ( -f $disabled_file )
+ {
+ $marked_as_disabled= 1;
+ $tinfo->{'comment'}= mtr_fromfile($disabled_file);
+ }
+
+ # If test was marked as disabled, either opt_enable_disabled is off and then
+ # we skip this test, or it is on and then we run this test but warn
+
+ if ( $marked_as_disabled )
+ {
+ if ( $::opt_enable_disabled )
+ {
+ $tinfo->{'dont_skip_though_disabled'}= 1;
+ }
+ else
+ {
+ $tinfo->{'skip'}= 1;
+ $tinfo->{'disable'}= 1; # Sub type of 'skip'
+ return;
+ }
+ }
+
+ if ( $component_id eq 'im' )
+ {
+ if ( $::glob_use_embedded_server )
+ {
+ $tinfo->{'skip'}= 1;
+ $tinfo->{'comment'}= "No IM with embedded server";
+ return;
+ }
+ elsif ( $::opt_ps_protocol )
+ {
+ $tinfo->{'skip'}= 1;
+ $tinfo->{'comment'}= "No IM with --ps-protocol";
+ return;
+ }
+ elsif ( $::opt_skip_im )
+ {
+ $tinfo->{'skip'}= 1;
+ $tinfo->{'comment'}= "No IM tests(--skip-im)";
+ return;
+ }
+ }
+ else
+ {
+ mtr_options_from_test_file($tinfo,"$testdir/${tname}.test");
+
+ if ( defined $::used_default_engine )
+ {
+ # Different default engine is used
+ # tag test to require that engine
+
+ $tinfo->{'innodb_test'}= 1
+ if ( $::used_default_engine =~ /^innodb/i );
+ }
+
+ #enable federated for this test
+ if ($tinfo->{'federated_test'})
+ {
+ push(@{$tinfo->{'master_opt'}}, "--loose-federated");
+ push(@{$tinfo->{'slave_opt'}}, "--loose-federated");
+ }
+
+ if ( $tinfo->{'big_test'} and ! $::opt_big_test )
+ {
+ $tinfo->{'skip'}= 1;
+ $tinfo->{'comment'}= "Test need 'big-test' option";
+ return;
+ }
+
+ if ( $tinfo->{'need_debug'} && ! $::debug_compiled_binaries )
+ {
+ $tinfo->{'skip'}= 1;
+ $tinfo->{'comment'}= "Test need debug binaries";
+ return;
+ }
+
+ if ( $tinfo->{'innodb_test'} )
+ {
+ # This is a test that need innodb
+ if ( $::mysqld_variables{'innodb'} eq "OFF" )
+ {
+ # innodb is not supported, skip it
+ $tinfo->{'skip'}= 1;
+ $tinfo->{'comment'}= "No innodb support";
+ return;
+ }
+ }
+
+ if ( $tinfo->{'need_binlog'} )
+ {
+ if (grep(/^--skip-log-bin/, @::opt_extra_mysqld_opt) )
+ {
+ $tinfo->{'skip'}= 1;
+ $tinfo->{'comment'}= "Test need binlog";
+ return;
+ }
+ }
+ else
+ {
+ if ( $::mysql_version_id >= 50100 )
+ {
+ # Test does not need binlog, add --skip-binlog to
+ # the options used when starting it
+ push(@{$tinfo->{'master_opt'}}, "--skip-log-bin");
+ }
+ }
+
+ }
+}
+
+
+# List of tags in the .test files that if found should set
+# the specified value in "tinfo"
+our @tags=
+(
+
+ ["include/have_binlog_format_row.inc", "binlog_formats", ["row"]],
+ ["include/have_binlog_format_statement.inc", "binlog_formats", ["statement"]],
+ ["include/have_binlog_format_mixed.inc", "binlog_formats", ["mixed"]],
+ ["include/have_binlog_format_mixed_or_row.inc",
+ "binlog_formats", ["mixed", "row"]],
+ ["include/have_binlog_format_mixed_or_statement.inc",
+ "binlog_formats", ["mixed", "statement"]],
+ ["include/have_binlog_format_row_or_statement.inc",
+ "binlog_formats", ["row", "statement"]],
+
+ ["include/have_innodb.inc", "innodb_test", 1],
+ ["include/have_log_bin.inc", "need_binlog", 1],
+ ["include/big_test.inc", "big_test", 1],
+ ["include/have_debug.inc", "need_debug", 1],
+ ["require_manager", "require_manager", 1],
+ ["include/federated.inc", "federated_test", 1],
+ ["include/have_federated_db.inc", "federated_test", 1],
+);
+
+sub mtr_options_from_test_file($$) {
+ my $tinfo= shift;
+ my $file= shift;
+ #mtr_verbose("$file");
+ my $F= IO::File->new($file) or mtr_error("can't open file \"$file\": $!");
+
+ while ( my $line= <$F> )
+ {
+
+ # Skip line if it start's with #
+ next if ( $line =~ /^#/ );
+
+ # Match this line against tag in "tags" array
+ foreach my $tag (@tags)
+ {
+ if ( index($line, $tag->[0]) >= 0 )
+ {
+ # Tag matched, assign value to "tinfo"
+ $tinfo->{"$tag->[1]"}= $tag->[2];
+ }
+ }
+
+ # If test sources another file, open it as well
+ if ( $line =~ /^\-\-([[:space:]]*)source(.*)$/ or
+ $line =~ /^([[:space:]]*)source(.*);$/ )
+ {
+ my $value= $2;
+ $value =~ s/^\s+//; # Remove leading space
+ $value =~ s/[[:space:]]+$//; # Remove ending space
+
+ my $sourced_file= "$::glob_mysql_test_dir/$value";
+ if ( -f $sourced_file )
+ {
+ # Only source the file if it exists, we may get
+ # false positives in the regexes above if someone
+ # writes "source nnnn;" in a test case(such as mysqltest.test)
+ mtr_options_from_test_file($tinfo, $sourced_file);
+ }
+ }
+ }
+}
+
+
+sub print_testcases {
+ my (@cases)= @_;
+
+ 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";
+ }
+ print "=" x 60, "\n";
+}
+
+
+1;
diff --git a/mysql-test/lib/v1/mtr_gcov.pl b/mysql-test/lib/v1/mtr_gcov.pl
new file mode 100644
index 00000000..b5839fe4
--- /dev/null
+++ b/mysql-test/lib/v1/mtr_gcov.pl
@@ -0,0 +1,75 @@
+# -*- cperl -*-
+# Copyright (c) 2004, 2006 MySQL AB, 2008 Sun Microsystems, Inc.
+# Use is subject to license terms.
+#
+# 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-1335 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;
diff --git a/mysql-test/lib/v1/mtr_gprof.pl b/mysql-test/lib/v1/mtr_gprof.pl
new file mode 100644
index 00000000..c794eb5f
--- /dev/null
+++ b/mysql-test/lib/v1/mtr_gprof.pl
@@ -0,0 +1,65 @@
+# -*- cperl -*-
+# Copyright (c) 2004 MySQL AB, 2008 Sun Microsystems, Inc.
+# Use is subject to license terms.
+#
+# 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-1335 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;
diff --git a/mysql-test/lib/v1/mtr_im.pl b/mysql-test/lib/v1/mtr_im.pl
new file mode 100644
index 00000000..2aff160d
--- /dev/null
+++ b/mysql-test/lib/v1/mtr_im.pl
@@ -0,0 +1,776 @@
+# -*- cperl -*-
+# Copyright (c) 2006 MySQL AB, 2008 Sun Microsystems, Inc.
+# Use is subject to license terms.
+#
+# 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-1335 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;
+
+# Private IM-related operations.
+
+sub mtr_im_kill_process ($$$$);
+sub mtr_im_load_pids ($);
+sub mtr_im_terminate ($);
+sub mtr_im_check_alive ($);
+sub mtr_im_check_main_alive ($);
+sub mtr_im_check_angel_alive ($);
+sub mtr_im_check_mysqlds_alive ($);
+sub mtr_im_check_mysqld_alive ($);
+sub mtr_im_cleanup ($);
+sub mtr_im_rm_file ($);
+sub mtr_im_errlog ($);
+sub mtr_im_kill ($);
+sub mtr_im_wait_for_connection ($$$);
+sub mtr_im_wait_for_mysqld($$$);
+
+# Public IM-related operations.
+
+sub mtr_im_start ($$);
+sub mtr_im_stop ($);
+
+##############################################################################
+#
+# Private operations.
+#
+##############################################################################
+
+sub mtr_im_kill_process ($$$$) {
+ my $pid_lst= shift;
+ my $signal= shift;
+ my $total_retries= shift;
+ my $timeout= shift;
+
+ my %pids;
+
+ foreach my $pid ( @{$pid_lst} )
+ {
+ $pids{$pid}= 1;
+ }
+
+ for ( my $cur_attempt= 1; $cur_attempt <= $total_retries; ++$cur_attempt )
+ {
+ foreach my $pid ( keys %pids )
+ {
+ mtr_debug("Sending $signal to $pid...");
+
+ kill($signal, $pid);
+
+ unless ( kill (0, $pid) )
+ {
+ mtr_debug("Process $pid died.");
+ delete $pids{$pid};
+ }
+ }
+
+ return if scalar keys %pids == 0;
+
+ mtr_debug("Sleeping $timeout second(s) waiting for processes to die...");
+
+ sleep($timeout);
+ }
+
+ mtr_debug("Process(es) " .
+ join(' ', keys %pids) .
+ " is still alive after $total_retries " .
+ "of sending signal $signal.");
+}
+
+###########################################################################
+
+sub mtr_im_load_pids($) {
+ my $im= shift;
+
+ mtr_debug("Loading PID files...");
+
+ # Obtain mysqld-process pids.
+
+ my $instances = $im->{'instances'};
+
+ for ( my $idx= 0; $idx < 2; ++$idx )
+ {
+ mtr_debug("IM-guarded mysqld[$idx] PID file: '" .
+ $instances->[$idx]->{'path_pid'} . "'.");
+
+ my $mysqld_pid;
+
+ if ( -r $instances->[$idx]->{'path_pid'} )
+ {
+ $mysqld_pid= mtr_get_pid_from_file($instances->[$idx]->{'path_pid'});
+ mtr_debug("IM-guarded mysqld[$idx] PID: $mysqld_pid.");
+ }
+ else
+ {
+ $mysqld_pid= undef;
+ mtr_debug("IM-guarded mysqld[$idx]: no PID file.");
+ }
+
+ $instances->[$idx]->{'pid'}= $mysqld_pid;
+ }
+
+ # Re-read Instance Manager PIDs from the file, since during tests Instance
+ # Manager could have been restarted, so its PIDs could have been changed.
+
+ # - IM-main
+
+ mtr_debug("IM-main PID file: '$im->{path_pid}'.");
+
+ if ( -f $im->{'path_pid'} )
+ {
+ $im->{'pid'} =
+ mtr_get_pid_from_file($im->{'path_pid'});
+
+ mtr_debug("IM-main PID: $im->{pid}.");
+ }
+ else
+ {
+ mtr_debug("IM-main: no PID file.");
+ $im->{'pid'}= undef;
+ }
+
+ # - IM-angel
+
+ mtr_debug("IM-angel PID file: '$im->{path_angel_pid}'.");
+
+ if ( -f $im->{'path_angel_pid'} )
+ {
+ $im->{'angel_pid'} =
+ mtr_get_pid_from_file($im->{'path_angel_pid'});
+
+ mtr_debug("IM-angel PID: $im->{'angel_pid'}.");
+ }
+ else
+ {
+ mtr_debug("IM-angel: no PID file.");
+ $im->{'angel_pid'} = undef;
+ }
+}
+
+###########################################################################
+
+sub mtr_im_terminate($) {
+ my $im= shift;
+
+ # Load pids from pid-files. We should do it first of all, because IM deletes
+ # them on shutdown.
+
+ mtr_im_load_pids($im);
+
+ mtr_debug("Shutting Instance Manager down...");
+
+ # Ignoring SIGCHLD so that all children could rest in peace.
+
+ start_reap_all();
+
+ # Send SIGTERM to IM-main.
+
+ if ( defined $im->{'pid'} )
+ {
+ mtr_debug("IM-main pid: $im->{pid}.");
+ mtr_debug("Stopping IM-main...");
+
+ mtr_im_kill_process([ $im->{'pid'} ], 'TERM', 10, 1);
+ }
+ else
+ {
+ mtr_debug("IM-main pid: n/a.");
+ }
+
+ # If IM-angel was alive, wait for it to die.
+
+ if ( defined $im->{'angel_pid'} )
+ {
+ mtr_debug("IM-angel pid: $im->{'angel_pid'}.");
+ mtr_debug("Waiting for IM-angel to die...");
+
+ my $total_attempts= 10;
+
+ for ( my $cur_attempt=1; $cur_attempt <= $total_attempts; ++$cur_attempt )
+ {
+ unless ( kill (0, $im->{'angel_pid'}) )
+ {
+ mtr_debug("IM-angel died.");
+ last;
+ }
+
+ sleep(1);
+ }
+ }
+ else
+ {
+ mtr_debug("IM-angel pid: n/a.");
+ }
+
+ stop_reap_all();
+
+ # Re-load PIDs.
+
+ mtr_im_load_pids($im);
+}
+
+###########################################################################
+
+sub mtr_im_check_alive($) {
+ my $im= shift;
+
+ mtr_debug("Checking whether IM-components are alive...");
+
+ return 1 if mtr_im_check_main_alive($im);
+
+ return 1 if mtr_im_check_angel_alive($im);
+
+ return 1 if mtr_im_check_mysqlds_alive($im);
+
+ return 0;
+}
+
+###########################################################################
+
+sub mtr_im_check_main_alive($) {
+ my $im= shift;
+
+ # Check that the process, that we know to be IM's, is dead.
+
+ if ( defined $im->{'pid'} )
+ {
+ if ( kill (0, $im->{'pid'}) )
+ {
+ mtr_debug("IM-main (PID: $im->{pid}) is alive.");
+ return 1;
+ }
+ else
+ {
+ mtr_debug("IM-main (PID: $im->{pid}) is dead.");
+ }
+ }
+ else
+ {
+ mtr_debug("No PID file for IM-main.");
+ }
+
+ # Check that IM does not accept client connections.
+
+ if ( mtr_ping_port($im->{'port'}) )
+ {
+ mtr_debug("IM-main (port: $im->{port}) " .
+ "is accepting connections.");
+
+ mtr_im_errlog("IM-main is accepting connections on port " .
+ "$im->{port}, but there is no " .
+ "process information.");
+ return 1;
+ }
+ else
+ {
+ mtr_debug("IM-main (port: $im->{port}) " .
+ "does not accept connections.");
+ return 0;
+ }
+}
+
+###########################################################################
+
+sub mtr_im_check_angel_alive($) {
+ my $im= shift;
+
+ # Check that the process, that we know to be the Angel, is dead.
+
+ if ( defined $im->{'angel_pid'} )
+ {
+ if ( kill (0, $im->{'angel_pid'}) )
+ {
+ mtr_debug("IM-angel (PID: $im->{angel_pid}) is alive.");
+ return 1;
+ }
+ else
+ {
+ mtr_debug("IM-angel (PID: $im->{angel_pid}) is dead.");
+ return 0;
+ }
+ }
+ else
+ {
+ mtr_debug("No PID file for IM-angel.");
+ return 0;
+ }
+}
+
+###########################################################################
+
+sub mtr_im_check_mysqlds_alive($) {
+ my $im= shift;
+
+ mtr_debug("Checking for IM-guarded mysqld instances...");
+
+ my $instances = $im->{'instances'};
+
+ for ( my $idx= 0; $idx < 2; ++$idx )
+ {
+ mtr_debug("Checking mysqld[$idx]...");
+
+ return 1
+ if mtr_im_check_mysqld_alive($instances->[$idx]);
+ }
+}
+
+###########################################################################
+
+sub mtr_im_check_mysqld_alive($) {
+ my $mysqld_instance= shift;
+
+ # Check that the process is dead.
+
+ if ( defined $mysqld_instance->{'pid'} )
+ {
+ if ( kill (0, $mysqld_instance->{'pid'}) )
+ {
+ mtr_debug("Mysqld instance (PID: $mysqld_instance->{pid}) is alive.");
+ return 1;
+ }
+ else
+ {
+ mtr_debug("Mysqld instance (PID: $mysqld_instance->{pid}) is dead.");
+ }
+ }
+ else
+ {
+ mtr_debug("No PID file for mysqld instance.");
+ }
+
+ # Check that mysqld does not accept client connections.
+
+ if ( mtr_ping_port($mysqld_instance->{'port'}) )
+ {
+ mtr_debug("Mysqld instance (port: $mysqld_instance->{port}) " .
+ "is accepting connections.");
+
+ mtr_im_errlog("Mysqld is accepting connections on port " .
+ "$mysqld_instance->{port}, but there is no " .
+ "process information.");
+ return 1;
+ }
+ else
+ {
+ mtr_debug("Mysqld instance (port: $mysqld_instance->{port}) " .
+ "does not accept connections.");
+ return 0;
+ }
+}
+
+###########################################################################
+
+sub mtr_im_cleanup($) {
+ my $im= shift;
+
+ mtr_im_rm_file($im->{'path_pid'});
+ mtr_im_rm_file($im->{'path_sock'});
+
+ mtr_im_rm_file($im->{'path_angel_pid'});
+
+ for ( my $idx= 0; $idx < 2; ++$idx )
+ {
+ mtr_im_rm_file($im->{'instances'}->[$idx]->{'path_pid'});
+ mtr_im_rm_file($im->{'instances'}->[$idx]->{'path_sock'});
+ }
+}
+
+###########################################################################
+
+sub mtr_im_rm_file($)
+{
+ my $file_path= shift;
+
+ if ( -f $file_path )
+ {
+ mtr_debug("Removing '$file_path'...");
+
+ unless ( unlink($file_path) )
+ {
+ mtr_warning("Can not remove '$file_path'.")
+ }
+ }
+ else
+ {
+ mtr_debug("File '$file_path' does not exist already.");
+ }
+}
+
+###########################################################################
+
+sub mtr_im_errlog($) {
+ my $msg= shift;
+
+ # Complain in error log so that a warning will be shown.
+ #
+ # TODO: unless BUG#20761 is fixed, we will print the warning to stdout, so
+ # that it can be seen on console and does not produce pushbuild error.
+
+ # my $errlog= "$opt_vardir/log/mysql-test-run.pl.err";
+ #
+ # open (ERRLOG, ">>$errlog") ||
+ # mtr_error("Can not open error log ($errlog)");
+ #
+ # my $ts= localtime();
+ # print ERRLOG
+ # "Warning: [$ts] $msg\n";
+ #
+ # close ERRLOG;
+
+ my $ts= localtime();
+ print "Warning: [$ts] $msg\n";
+}
+
+###########################################################################
+
+sub mtr_im_kill($) {
+ my $im= shift;
+
+ # Re-load PIDs. That can be useful because some processes could have been
+ # restarted.
+
+ mtr_im_load_pids($im);
+
+ # Ignoring SIGCHLD so that all children could rest in peace.
+
+ start_reap_all();
+
+ # Kill IM-angel first of all.
+
+ if ( defined $im->{'angel_pid'} )
+ {
+ mtr_debug("Killing IM-angel (PID: $im->{angel_pid})...");
+ mtr_im_kill_process([ $im->{'angel_pid'} ], 'KILL', 10, 1)
+ }
+ else
+ {
+ mtr_debug("IM-angel is dead.");
+ }
+
+ # Re-load PIDs again.
+
+ mtr_im_load_pids($im);
+
+ # Kill IM-main.
+
+ if ( defined $im->{'pid'} )
+ {
+ mtr_debug("Killing IM-main (PID: $im->pid})...");
+ mtr_im_kill_process([ $im->{'pid'} ], 'KILL', 10, 1);
+ }
+ else
+ {
+ mtr_debug("IM-main is dead.");
+ }
+
+ # Re-load PIDs again.
+
+ mtr_im_load_pids($im);
+
+ # Kill guarded mysqld instances.
+
+ my @mysqld_pids;
+
+ mtr_debug("Collecting PIDs of mysqld instances to kill...");
+
+ for ( my $idx= 0; $idx < 2; ++$idx )
+ {
+ my $pid= $im->{'instances'}->[$idx]->{'pid'};
+
+ unless ( defined $pid )
+ {
+ next;
+ }
+
+ mtr_debug(" - IM-guarded mysqld[$idx] PID: $pid.");
+
+ push (@mysqld_pids, $pid);
+ }
+
+ if ( scalar @mysqld_pids > 0 )
+ {
+ mtr_debug("Killing IM-guarded mysqld instances...");
+ mtr_im_kill_process(\@mysqld_pids, 'KILL', 10, 1);
+ }
+
+ # That's all.
+
+ stop_reap_all();
+}
+
+##############################################################################
+
+sub mtr_im_wait_for_connection($$$) {
+ my $im= shift;
+ my $total_attempts= shift;
+ my $connect_timeout= shift;
+
+ mtr_debug("Waiting for IM on port $im->{port} " .
+ "to start accepting connections...");
+
+ for ( my $cur_attempt= 1; $cur_attempt <= $total_attempts; ++$cur_attempt )
+ {
+ mtr_debug("Trying to connect to IM ($cur_attempt of $total_attempts)...");
+
+ if ( mtr_ping_port($im->{'port'}) )
+ {
+ mtr_debug("IM is accepting connections " .
+ "on port $im->{port}.");
+ return 1;
+ }
+
+ mtr_debug("Sleeping $connect_timeout...");
+ sleep($connect_timeout);
+ }
+
+ mtr_debug("IM does not accept connections " .
+ "on port $im->{port} after " .
+ ($total_attempts * $connect_timeout) . " seconds.");
+
+ return 0;
+}
+
+##############################################################################
+
+sub mtr_im_wait_for_mysqld($$$) {
+ my $mysqld= shift;
+ my $total_attempts= shift;
+ my $connect_timeout= shift;
+
+ mtr_debug("Waiting for IM-guarded mysqld on port $mysqld->{port} " .
+ "to start accepting connections...");
+
+ for ( my $cur_attempt= 1; $cur_attempt <= $total_attempts; ++$cur_attempt )
+ {
+ mtr_debug("Trying to connect to mysqld " .
+ "($cur_attempt of $total_attempts)...");
+
+ if ( mtr_ping_port($mysqld->{'port'}) )
+ {
+ mtr_debug("Mysqld is accepting connections " .
+ "on port $mysqld->{port}.");
+ return 1;
+ }
+
+ mtr_debug("Sleeping $connect_timeout...");
+ sleep($connect_timeout);
+ }
+
+ mtr_debug("Mysqld does not accept connections " .
+ "on port $mysqld->{port} after " .
+ ($total_attempts * $connect_timeout) . " seconds.");
+
+ return 0;
+}
+
+##############################################################################
+#
+# Public operations.
+#
+##############################################################################
+
+sub mtr_im_start($$) {
+ my $im = shift;
+ my $opts = shift;
+
+ mtr_debug("Starting Instance Manager...");
+
+ my $args;
+ mtr_init_args(\$args);
+ mtr_add_arg($args, "--defaults-file=%s", $im->{'defaults_file'});
+
+ foreach my $opt ( @{$opts} )
+ {
+ mtr_add_arg($args, $opt);
+ }
+
+ $im->{'spawner_pid'} =
+ mtr_spawn(
+ $::exe_im, # path to the executable
+ $args, # cmd-line args
+ '', # stdin
+ $im->{'path_log'}, # stdout
+ $im->{'path_err'}, # stderr
+ '', # pid file path (not used)
+ { append_log_file => 1 } # append log files
+ );
+
+ unless ( $im->{'spawner_pid'} )
+ {
+ mtr_error('Could not start Instance Manager.')
+ }
+
+ # Instance Manager can be run in daemon mode. In this case, it creates
+ # several processes and the parent process, created by mtr_spawn(), exits just
+ # after start. So, we have to obtain Instance Manager PID from the PID file.
+
+ mtr_debug("Waiting for IM to create PID file (" .
+ "path: '$im->{path_pid}'; " .
+ "timeout: $im->{start_timeout})...");
+
+ unless ( sleep_until_file_created($im->{'path_pid'},
+ $im->{'start_timeout'},
+ -1) ) # real PID is still unknown
+ {
+ mtr_debug("IM has not created PID file in $im->{start_timeout} secs.");
+ mtr_debug("Aborting test suite...");
+
+ mtr_kill_leftovers();
+
+ mtr_report("IM has not created PID file in $im->{start_timeout} secs.");
+ return 0;
+ }
+
+ $im->{'pid'}= mtr_get_pid_from_file($im->{'path_pid'});
+
+ mtr_debug("Instance Manager started. PID: $im->{pid}.");
+
+ # Wait until we can connect to IM.
+
+ my $IM_CONNECT_TIMEOUT= 30;
+
+ unless ( mtr_im_wait_for_connection($im,
+ $IM_CONNECT_TIMEOUT, 1) )
+ {
+ mtr_debug("Can not connect to Instance Manager " .
+ "in $IM_CONNECT_TIMEOUT seconds after start.");
+ mtr_debug("Aborting test suite...");
+
+ mtr_kill_leftovers();
+
+ mtr_report("Can not connect to Instance Manager " .
+ "in $IM_CONNECT_TIMEOUT seconds after start.");
+ return 0;
+ }
+
+ # Wait for IM to start guarded instances:
+ # - wait for PID files;
+
+ mtr_debug("Waiting for guarded mysqlds instances to create PID files...");
+
+ for ( my $idx= 0; $idx < 2; ++$idx )
+ {
+ my $mysqld= $im->{'instances'}->[$idx];
+
+ if ( exists $mysqld->{'nonguarded'} )
+ {
+ next;
+ }
+
+ mtr_debug("Waiting for mysqld[$idx] to create PID file (" .
+ "path: '$mysqld->{path_pid}'; " .
+ "timeout: $mysqld->{start_timeout})...");
+
+ unless ( sleep_until_file_created($mysqld->{'path_pid'},
+ $mysqld->{'start_timeout'},
+ -1) ) # real PID is still unknown
+ {
+ mtr_debug("mysqld[$idx] has not created PID file in " .
+ "$mysqld->{start_timeout} secs.");
+ mtr_debug("Aborting test suite...");
+
+ mtr_kill_leftovers();
+
+ mtr_report("mysqld[$idx] has not created PID file in " .
+ "$mysqld->{start_timeout} secs.");
+ return 0;
+ }
+
+ mtr_debug("PID file for mysqld[$idx] ($mysqld->{path_pid} created.");
+ }
+
+ # Wait until we can connect to guarded mysqld-instances
+ # (in other words -- wait for IM to start guarded instances).
+
+ mtr_debug("Waiting for guarded mysqlds to start accepting connections...");
+
+ for ( my $idx= 0; $idx < 2; ++$idx )
+ {
+ my $mysqld= $im->{'instances'}->[$idx];
+
+ if ( exists $mysqld->{'nonguarded'} )
+ {
+ next;
+ }
+
+ mtr_debug("Waiting for mysqld[$idx] to accept connection...");
+
+ unless ( mtr_im_wait_for_mysqld($mysqld, 30, 1) )
+ {
+ mtr_debug("Can not connect to mysqld[$idx] " .
+ "in $IM_CONNECT_TIMEOUT seconds after start.");
+ mtr_debug("Aborting test suite...");
+
+ mtr_kill_leftovers();
+
+ mtr_report("Can not connect to mysqld[$idx] " .
+ "in $IM_CONNECT_TIMEOUT seconds after start.");
+ return 0;
+ }
+
+ mtr_debug("mysqld[$idx] started.");
+ }
+
+ mtr_debug("Instance Manager and its components are up and running.");
+
+ return 1;
+}
+
+##############################################################################
+
+sub mtr_im_stop($) {
+ my $im= shift;
+
+ mtr_debug("Stopping Instance Manager...");
+
+ # Try graceful shutdown.
+
+ mtr_im_terminate($im);
+
+ # Check that all processes died.
+
+ unless ( mtr_im_check_alive($im) )
+ {
+ mtr_debug("Instance Manager has been stopped successfully.");
+ mtr_im_cleanup($im);
+ return 1;
+ }
+
+ # Instance Manager don't want to die. We should kill it.
+
+ mtr_im_errlog("Instance Manager did not shutdown gracefully.");
+
+ mtr_im_kill($im);
+
+ # Check again that all IM-related processes have been killed.
+
+ my $im_is_alive= mtr_im_check_alive($im);
+
+ mtr_im_cleanup($im);
+
+ if ( $im_is_alive )
+ {
+ mtr_debug("Can not kill Instance Manager or its children.");
+ return 0;
+ }
+
+ mtr_debug("Instance Manager has been killed successfully.");
+ return 1;
+}
+
+###########################################################################
+
+1;
diff --git a/mysql-test/lib/v1/mtr_io.pl b/mysql-test/lib/v1/mtr_io.pl
new file mode 100644
index 00000000..2176c07f
--- /dev/null
+++ b/mysql-test/lib/v1/mtr_io.pl
@@ -0,0 +1,218 @@
+# -*- cperl -*-
+# Copyright (c) 2004, 2010, 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-1335 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;
+
+ # --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;
diff --git a/mysql-test/lib/v1/mtr_match.pl b/mysql-test/lib/v1/mtr_match.pl
new file mode 100644
index 00000000..f1933cd9
--- /dev/null
+++ b/mysql-test/lib/v1/mtr_match.pl
@@ -0,0 +1,99 @@
+# -*- cperl -*-
+# Copyright (c) 2004-2006 MySQL AB, 2008 Sun Microsystems, Inc.
+# Use is subject to license terms.
+#
+# 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-1335 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;
diff --git a/mysql-test/lib/v1/mtr_misc.pl b/mysql-test/lib/v1/mtr_misc.pl
new file mode 100644
index 00000000..e7c652b4
--- /dev/null
+++ b/mysql-test/lib/v1/mtr_misc.pl
@@ -0,0 +1,311 @@
+# -*- cperl -*-
+# Copyright (c) 2004, 2010, 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-1335 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;
+ 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;
diff --git a/mysql-test/lib/v1/mtr_process.pl b/mysql-test/lib/v1/mtr_process.pl
new file mode 100644
index 00000000..fd9f3817
--- /dev/null
+++ b/mysql-test/lib/v1/mtr_process.pl
@@ -0,0 +1,1022 @@
+# -*- cperl -*-
+# Copyright (c) 2004-2006 MySQL AB, 2008 Sun Microsystems, Inc.
+# Use is subject to license terms.
+#
+# 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-1335 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 Socket;
+use Errno;
+use strict;
+
+use POSIX qw(WNOHANG SIGHUP);
+
+sub mtr_run ($$$$$$;$);
+sub mtr_spawn ($$$$$$;$);
+sub mtr_check_stop_servers ($);
+sub mtr_kill_leftovers ();
+sub mtr_wait_blocking ($);
+sub mtr_record_dead_children ();
+sub mtr_mysqladmin_start($$$);
+sub mtr_exit ($);
+sub sleep_until_file_created ($$$);
+sub mtr_kill_processes ($);
+sub mtr_ping_with_timeout($);
+sub mtr_ping_port ($);
+
+# Local function
+sub spawn_impl ($$$$$$$);
+
+##############################################################################
+#
+# Execute an external command
+#
+##############################################################################
+
+sub mtr_run ($$$$$$;$) {
+ my $path= shift;
+ my $arg_list_t= shift;
+ my $input= shift;
+ my $output= shift;
+ my $error= shift;
+ my $pid_file= shift; # Not used
+ my $spawn_opts= shift;
+
+ return spawn_impl($path,$arg_list_t,'run',$input,$output,$error,
+ $spawn_opts);
+}
+
+sub mtr_run_test ($$$$$$;$) {
+ my $path= shift;
+ my $arg_list_t= shift;
+ my $input= shift;
+ my $output= shift;
+ my $error= shift;
+ my $pid_file= shift; # Not used
+ my $spawn_opts= shift;
+
+ return spawn_impl($path,$arg_list_t,'test',$input,$output,$error,
+ $spawn_opts);
+}
+
+sub mtr_spawn ($$$$$$;$) {
+ my $path= shift;
+ my $arg_list_t= shift;
+ my $input= shift;
+ my $output= shift;
+ my $error= shift;
+ my $pid_file= shift; # Not used
+ my $spawn_opts= shift;
+
+ return spawn_impl($path,$arg_list_t,'spawn',$input,$output,$error,
+ $spawn_opts);
+}
+
+
+
+sub spawn_impl ($$$$$$$) {
+ my $path= shift;
+ my $arg_list_t= shift;
+ my $mode= shift;
+ my $input= shift;
+ my $output= shift;
+ my $error= shift;
+ my $spawn_opts= shift;
+
+ if ( $::opt_script_debug )
+ {
+ mtr_report("");
+ mtr_debug("-" x 73);
+ mtr_debug("STDIN $input") if $input;
+ mtr_debug("STDOUT $output") if $output;
+ mtr_debug("STDERR $error") if $error;
+ mtr_debug("$mode: $path ", join(" ",@$arg_list_t));
+ mtr_debug("spawn options:");
+ if ($spawn_opts)
+ {
+ foreach my $key (sort keys %{$spawn_opts})
+ {
+ mtr_debug(" - $key: $spawn_opts->{$key}");
+ }
+ }
+ else
+ {
+ mtr_debug(" none");
+ }
+ mtr_debug("-" x 73);
+ mtr_report("");
+ }
+
+ mtr_error("Can't spawn with empty \"path\"") unless defined $path;
+
+
+ FORK:
+ {
+ my $pid= fork();
+
+ if ( ! defined $pid )
+ {
+ if ( $! == $!{EAGAIN} ) # See "perldoc Errno"
+ {
+ mtr_warning("Got EAGAIN from fork(), sleep 1 second and redo");
+ sleep(1);
+ redo FORK;
+ }
+
+ mtr_error("$path ($pid) can't be forked, error: $!");
+
+ }
+
+ if ( $pid )
+ {
+ select(STDOUT) if $::glob_win32_perl;
+ return spawn_parent_impl($pid,$mode,$path);
+ }
+ else
+ {
+ # Child, redirect output and exec
+
+ $SIG{INT}= 'DEFAULT'; # Parent do some stuff, we don't
+
+ my $log_file_open_mode = '>';
+
+ if ($spawn_opts and $spawn_opts->{'append_log_file'})
+ {
+ $log_file_open_mode = '>>';
+ }
+
+ if ( $output )
+ {
+ if ( $::glob_win32_perl )
+ {
+ # Don't redirect stdout on ActiveState perl since this is
+ # just another thread in the same process.
+ }
+ elsif ( ! open(STDOUT,$log_file_open_mode,$output) )
+ {
+ mtr_child_error("can't redirect STDOUT to \"$output\": $!");
+ }
+ }
+
+ if ( $error )
+ {
+ if ( !$::glob_win32_perl and $output eq $error )
+ {
+ if ( ! open(STDERR,">&STDOUT") )
+ {
+ mtr_child_error("can't dup STDOUT: $!");
+ }
+ }
+ else
+ {
+ if ( ! open(STDERR,$log_file_open_mode,$error) )
+ {
+ mtr_child_error("can't redirect STDERR to \"$error\": $!");
+ }
+ }
+ }
+
+ if ( $input )
+ {
+ if ( ! open(STDIN,"<",$input) )
+ {
+ mtr_child_error("can't redirect STDIN to \"$input\": $!");
+ }
+ }
+
+ if ( ! exec($path,@$arg_list_t) )
+ {
+ mtr_child_error("failed to execute \"$path\": $!");
+ }
+ mtr_error("Should never come here 1!");
+ }
+ mtr_error("Should never come here 2!");
+ }
+ mtr_error("Should never come here 3!");
+}
+
+
+sub spawn_parent_impl {
+ my $pid= shift;
+ my $mode= shift;
+ my $path= shift;
+
+ if ( $mode eq 'run' or $mode eq 'test' )
+ {
+ if ( $mode eq 'run' )
+ {
+ # Simple run of command, wait blocking for it to return
+ my $ret_pid= waitpid($pid,0);
+ if ( $ret_pid != $pid )
+ {
+ # The "simple" waitpid has failed, print debug info
+ # and try to handle the error
+ mtr_warning("waitpid($pid, 0) returned $ret_pid " .
+ "when waiting for '$path', error: '$!'");
+ if ( $ret_pid == -1 )
+ {
+ # waitpid returned -1, that would indicate the process
+ # no longer exist and waitpid couldn't wait for it.
+ return 1;
+ }
+ mtr_error("Error handling failed");
+ }
+
+ return mtr_process_exit_status($?);
+ }
+ else
+ {
+ # We run mysqltest and wait for it to return. But we try to
+ # catch dying mysqld processes as well.
+ #
+ # We do blocking waitpid() until we get the return from the
+ # "mysqltest" call. But if a mysqld process dies that we
+ # started, we take this as an error, and kill mysqltest.
+
+
+ my $exit_value= -1;
+ my $saved_exit_value;
+ my $ret_pid; # What waitpid() returns
+
+ while ( ($ret_pid= waitpid(-1,0)) != -1 )
+ {
+ # Someone terminated, don't know who. Collect
+ # status info first before $? is lost,
+ # but not $exit_value, this is flagged from
+
+ my $timer_name= mtr_timer_timeout($::glob_timers, $ret_pid);
+ if ( $timer_name )
+ {
+ if ( $timer_name eq "suite" )
+ {
+ # We give up here
+ print STDERR "\n";
+ kill(9, $pid); # Kill mysqltest
+ mtr_kill_leftovers(); # Kill servers the hard way
+ mtr_error("Test suite timeout");
+ }
+ elsif ( $timer_name eq "testcase" )
+ {
+ $saved_exit_value= 63; # Mark as timeout
+ kill(9, $pid); # Kill mysqltest
+ next; # Go on and catch the termination
+ }
+ }
+
+ if ( $ret_pid == $pid )
+ {
+ # We got termination of mysqltest, we are done
+ $exit_value= mtr_process_exit_status($?);
+ last;
+ }
+
+ # One of the child processes died, unless this was expected
+ # mysqltest should be killed and test aborted
+
+ check_expected_crash_and_restart($ret_pid);
+ }
+
+ if ( $ret_pid != $pid )
+ {
+ # We terminated the waiting because a "mysqld" process died.
+ # Kill the mysqltest process.
+ mtr_verbose("Kill mysqltest because another process died");
+ kill(9,$pid);
+
+ $ret_pid= waitpid($pid,0);
+
+ if ( $ret_pid != $pid )
+ {
+ mtr_error("$path ($pid) got lost somehow");
+ }
+ }
+
+ return $saved_exit_value || $exit_value;
+ }
+ }
+ else
+ {
+ # We spawned a process we don't wait for
+ return $pid;
+ }
+}
+
+
+# ----------------------------------------------------------------------
+# We try to emulate how an Unix shell calculates the exit code
+# ----------------------------------------------------------------------
+
+sub mtr_process_exit_status {
+ my $raw_status= shift;
+
+ if ( $raw_status & 127 )
+ {
+ return ($raw_status & 127) + 128; # Signal num + 128
+ }
+ else
+ {
+ return $raw_status >> 8; # Exit code
+ }
+}
+
+
+##############################################################################
+#
+# Kill processes left from previous runs
+#
+##############################################################################
+
+
+# Kill all processes that would conflict with this run
+# Make sure to remove the PID file, if any.
+sub mtr_kill_leftovers () {
+
+ mtr_report("Killing Possible Leftover Processes");
+ mtr_debug("mtr_kill_leftovers(): started.");
+
+ my @kill_pids;
+ my %admin_pids;
+
+ foreach my $srv (@{$::master}, @{$::slave})
+ {
+ mtr_debug(" - mysqld " .
+ "(pid: $srv->{pid}; " .
+ "pid file: '$srv->{path_pid}'; " .
+ "socket: '$srv->{path_sock}'; ".
+ "port: $srv->{port})");
+
+ my $pid= mtr_mysqladmin_start($srv, "shutdown", 20);
+
+ # Save the pid of the mysqladmin process
+ $admin_pids{$pid}= 1;
+
+ push(@kill_pids,{
+ pid => $srv->{'pid'},
+ pidfile => $srv->{'path_pid'},
+ sockfile => $srv->{'path_sock'},
+ port => $srv->{'port'},
+ });
+ $srv->{'pid'}= 0; # Assume we are done with it
+ }
+
+ # Wait for all the admin processes to complete
+ mtr_wait_blocking(\%admin_pids);
+
+ # If we trusted "mysqladmin --shutdown_timeout= ..." we could just
+ # terminate now, but we don't (FIXME should be debugged).
+ # So we try again to ping and at least wait the same amount of time
+ # mysqladmin would for all to die.
+
+ mtr_ping_with_timeout(\@kill_pids);
+
+ # We now have tried to terminate nice. We have waited for the listen
+ # port to be free, but can't really tell if the mysqld process died
+ # or not. We now try to find the process PID from the PID file, and
+ # send a kill to that process. Note that Perl let kill(0,@pids) be
+ # a way to just return the numer of processes the kernel can send
+ # signals to. So this can be used (except on Cygwin) to determine
+ # if there are processes left running that we cound out might exists.
+ #
+ # But still after all this work, all we know is that we have
+ # the ports free.
+
+ # We scan the "var/run/" directory for other process id's to kill
+
+ my $rundir= "$::opt_vardir/run";
+
+ mtr_debug("Processing PID files in directory '$rundir'...");
+
+ if ( -d $rundir )
+ {
+ opendir(RUNDIR, $rundir)
+ or mtr_error("can't open directory \"$rundir\": $!");
+
+ my @pids;
+
+ while ( my $elem= readdir(RUNDIR) )
+ {
+ # Only read pid from files that end with .pid
+ if ( $elem =~ /.*[.]pid$/)
+ {
+ my $pidfile= "$rundir/$elem";
+
+ if ( -f $pidfile )
+ {
+ mtr_debug("Processing PID file: '$pidfile'...");
+
+ my $pid= mtr_get_pid_from_file($pidfile);
+
+ mtr_debug("Got pid: $pid from file '$pidfile'");
+
+ if ( $::glob_cygwin_perl or kill(0, $pid) )
+ {
+ mtr_debug("There is process with pid $pid -- scheduling for kill.");
+ push(@pids, $pid); # We know (cygwin guess) it exists
+ }
+ else
+ {
+ mtr_debug("There is no process with pid $pid -- skipping.");
+ }
+ }
+ }
+ }
+ closedir(RUNDIR);
+
+ if ( @pids )
+ {
+ mtr_debug("Killing the following processes with PID files: " .
+ join(' ', @pids) . "...");
+
+ start_reap_all();
+
+ if ( $::glob_cygwin_perl )
+ {
+ # We have no (easy) way of knowing the Cygwin controlling
+ # process, in the PID file we only have the Windows process id.
+ system("kill -f " . join(" ",@pids)); # Hope for the best....
+ mtr_debug("Sleep 5 seconds waiting for processes to die");
+ sleep(5);
+ }
+ else
+ {
+ my $retries= 10; # 10 seconds
+ do
+ {
+ mtr_debug("Sending SIGKILL to pids: " . join(' ', @pids));
+ kill(9, @pids);
+ mtr_report("Sleep 1 second waiting for processes to die");
+ sleep(1) # Wait one second
+ } while ( $retries-- and kill(0, @pids) );
+
+ if ( kill(0, @pids) ) # Check if some left
+ {
+ mtr_warning("can't kill process(es) " . join(" ", @pids));
+ }
+ }
+
+ stop_reap_all();
+ }
+ }
+ else
+ {
+ mtr_debug("Directory for PID files ($rundir) does not exist.");
+ }
+
+ # We may have failed everything, but we now check again if we have
+ # the listen ports free to use, and if they are free, just go for it.
+
+ mtr_debug("Checking known mysqld servers...");
+
+ foreach my $srv ( @kill_pids )
+ {
+ if ( defined $srv->{'port'} and mtr_ping_port($srv->{'port'}) )
+ {
+ mtr_warning("can't kill old process holding port $srv->{'port'}");
+ }
+ }
+
+ mtr_debug("mtr_kill_leftovers(): finished.");
+}
+
+
+#
+# Check that all processes in "spec" are shutdown gracefully
+# else kill them off hard
+#
+sub mtr_check_stop_servers ($) {
+ my $spec= shift;
+
+ # Return if no processes are defined
+ return if ! @$spec;
+
+ mtr_verbose("mtr_check_stop_servers");
+
+ # ----------------------------------------------------------------------
+ # Wait until servers in "spec" has stopped listening
+ # to their ports or timeout occurs
+ # ----------------------------------------------------------------------
+ mtr_ping_with_timeout(\@$spec);
+
+ # ----------------------------------------------------------------------
+ # Use waitpid() nonblocking for a little while, to see how
+ # many process's will exit sucessfully.
+ # This is the normal case.
+ # ----------------------------------------------------------------------
+ my $wait_counter= 50; # Max number of times to redo the loop
+ foreach my $srv ( @$spec )
+ {
+ my $pid= $srv->{'pid'};
+ my $ret_pid;
+ if ( $pid )
+ {
+ $ret_pid= waitpid($pid,&WNOHANG);
+ if ($ret_pid == $pid)
+ {
+ mtr_verbose("Caught exit of process $ret_pid");
+ $srv->{'pid'}= 0;
+ }
+ elsif ($ret_pid == 0)
+ {
+ mtr_verbose("Process $pid is still alive");
+ if ($wait_counter-- > 0)
+ {
+ # Give the processes more time to exit
+ select(undef, undef, undef, (0.1));
+ redo;
+ }
+ }
+ else
+ {
+ mtr_warning("caught exit of unknown child $ret_pid");
+ }
+ }
+ }
+
+ # ----------------------------------------------------------------------
+ # The processes that haven't yet exited need to
+ # be killed hard, put them in "kill_pids" hash
+ # ----------------------------------------------------------------------
+ my %kill_pids;
+ foreach my $srv ( @$spec )
+ {
+ my $pid= $srv->{'pid'};
+ if ( $pid )
+ {
+ # Server is still alive, put it in list to be hard killed
+ if ($::glob_win32_perl)
+ {
+ # Kill the real process if it's known
+ $pid= $srv->{'real_pid'} if ($srv->{'real_pid'});
+ }
+ $kill_pids{$pid}= 1;
+
+ # Write a message to the process's error log (if it has one)
+ # that it's being killed hard.
+ if ( defined $srv->{'errfile'} )
+ {
+ mtr_tofile($srv->{'errfile'}, "Note: Forcing kill of process $pid\n");
+ }
+ mtr_warning("Forcing kill of process $pid");
+
+ }
+ else
+ {
+ # Server is dead, remove the pidfile if it exists
+ #
+ # Race, could have been removed between test with -f
+ # and the unlink() below, so better check again with -f
+ if ( -f $srv->{'pidfile'} and ! unlink($srv->{'pidfile'}) and
+ -f $srv->{'pidfile'} )
+ {
+ mtr_error("can't remove $srv->{'pidfile'}");
+ }
+ }
+ }
+
+ if ( ! keys %kill_pids )
+ {
+ # All processes has exited gracefully
+ return;
+ }
+
+ mtr_kill_processes(\%kill_pids);
+
+ # ----------------------------------------------------------------------
+ # All processes are killed, cleanup leftover files
+ # ----------------------------------------------------------------------
+ {
+ my $errors= 0;
+ foreach my $srv ( @$spec )
+ {
+ if ( $srv->{'pid'} )
+ {
+ # Server has been hard killed, clean it's resources
+ foreach my $file ($srv->{'pidfile'}, $srv->{'sockfile'})
+ {
+ # Know it is dead so should be no race, careful anyway
+ if ( defined $file and -f $file and ! unlink($file) and -f $file )
+ {
+ $errors++;
+ mtr_warning("couldn't delete $file");
+ }
+ }
+
+ if ($::glob_win32_perl and $srv->{'real_pid'})
+ {
+ # Wait for the pseudo pid - if the real_pid was known
+ # the pseudo pid has not been waited for yet, wai blocking
+ # since it's "such a simple program"
+ mtr_verbose("Wait for pseudo process $srv->{'pid'}");
+ my $ret_pid= waitpid($srv->{'pid'}, 0);
+ mtr_verbose("Pseudo process $ret_pid died");
+ }
+
+ $srv->{'pid'}= 0;
+ }
+ }
+ if ( $errors )
+ {
+ # There where errors killing processes
+ # do one last attempt to ping the servers
+ # and if they can't be pinged, assume they are dead
+ if ( ! mtr_ping_with_timeout( \@$spec ) )
+ {
+ mtr_error("we could not kill or clean up all processes");
+ }
+ else
+ {
+ mtr_verbose("All ports were free, continuing");
+ }
+ }
+ }
+}
+
+
+# Wait for all the process in the list to terminate
+sub mtr_wait_blocking($) {
+ my $admin_pids= shift;
+
+
+ # Return if no processes defined
+ return if ! %$admin_pids;
+
+ mtr_verbose("mtr_wait_blocking");
+
+ # Wait for all the started processes to exit
+ # As mysqladmin is such a simple program, we trust it to terminate itself.
+ # I.e. we wait blocking, and wait for them all before we go on.
+ foreach my $pid (keys %{$admin_pids})
+ {
+ my $ret_pid= waitpid($pid,0);
+
+ }
+}
+
+# Start "mysqladmin <command>" for a specific mysqld
+sub mtr_mysqladmin_start($$$) {
+ my $srv= shift;
+ my $command= shift;
+ my $adm_shutdown_tmo= shift;
+
+ my $args;
+ mtr_init_args(\$args);
+
+ mtr_add_arg($args, "--no-defaults");
+ mtr_add_arg($args, "--user=%s", $::opt_user);
+ mtr_add_arg($args, "--password=");
+ mtr_add_arg($args, "--silent");
+ if ( -e $srv->{'path_sock'} )
+ {
+ mtr_add_arg($args, "--socket=%s", $srv->{'path_sock'});
+ }
+ if ( $srv->{'port'} )
+ {
+ mtr_add_arg($args, "--port=%s", $srv->{'port'});
+ }
+ if ( $srv->{'port'} and ! -e $srv->{'path_sock'} )
+ {
+ mtr_add_arg($args, "--protocol=tcp"); # Needed if no --socket
+ }
+ mtr_add_arg($args, "--connect_timeout=5");
+
+ # Shutdown time must be high as slave may be in reconnect
+ mtr_add_arg($args, "--shutdown_timeout=$adm_shutdown_tmo");
+ mtr_add_arg($args, "$command");
+ my $pid= mtr_spawn($::exe_mysqladmin, $args,
+ "", "", "", "",
+ { append_log_file => 1 });
+ mtr_verbose("mtr_mysqladmin_start, pid: $pid");
+ return $pid;
+
+}
+
+# Ping all servers in list, exit when none of them answers
+# or when timeout has passed
+sub mtr_ping_with_timeout($) {
+ my $spec= shift;
+ my $timeout= 200; # 20 seconds max
+ my $res= 1; # If we just fall through, we are done
+ # in the sense that the servers don't
+ # listen to their ports any longer
+
+ mtr_debug("Waiting for mysqld servers to stop...");
+
+ TIME:
+ while ( $timeout-- )
+ {
+ foreach my $srv ( @$spec )
+ {
+ $res= 1; # We are optimistic
+ if ( $srv->{'pid'} and defined $srv->{'port'} )
+ {
+ if ( mtr_ping_port($srv->{'port'}) )
+ {
+ mtr_verbose("waiting for process $srv->{'pid'} to stop ".
+ "using port $srv->{'port'}");
+
+ # Millisceond sleep emulated with select
+ select(undef, undef, undef, (0.1));
+ $res= 0;
+ next TIME;
+ }
+ else
+ {
+ # Process was not using port
+ }
+ }
+ }
+ last; # If we got here, we are done
+ }
+
+ if ($res)
+ {
+ mtr_debug("mtr_ping_with_timeout(): All mysqld instances are down.");
+ }
+ else
+ {
+ mtr_report("mtr_ping_with_timeout(): At least one server is alive.");
+ }
+
+ return $res;
+}
+
+
+#
+# Loop through our list of processes and look for and entry
+# with the provided pid
+# Set the pid of that process to 0 if found
+#
+sub mark_process_dead($)
+{
+ my $ret_pid= shift;
+
+ foreach my $mysqld (@{$::master}, @{$::slave})
+ {
+ if ( $mysqld->{'pid'} eq $ret_pid )
+ {
+ mtr_verbose("$mysqld->{'type'} $mysqld->{'idx'} exited, pid: $ret_pid");
+ $mysqld->{'pid'}= 0;
+ return;
+ }
+ }
+
+ mtr_warning("mark_process_dead couldn't find an entry for pid: $ret_pid");
+
+}
+
+#
+# Loop through our list of processes and look for and entry
+# with the provided pid, if found check for the file indicating
+# expected crash and restart it.
+#
+sub check_expected_crash_and_restart($)
+{
+ my $ret_pid= shift;
+
+ foreach my $mysqld (@{$::master}, @{$::slave})
+ {
+ if ( $mysqld->{'pid'} eq $ret_pid )
+ {
+ mtr_verbose("$mysqld->{'type'} $mysqld->{'idx'} exited, pid: $ret_pid");
+ $mysqld->{'pid'}= 0;
+
+ # Check if crash expected, and restart if it was
+ my $expect_file= "$::opt_vardir/tmp/" . "$mysqld->{'type'}" .
+ "$mysqld->{'idx'}" . ".expect";
+ while ( 1 )
+ {
+ if ( -f $expect_file )
+ {
+ mtr_verbose("Crash was expected, file $expect_file exists");
+ my $expect_file_handler;
+ open($expect_file_handler, "<$expect_file") or die;
+ my @expect_lines= <$expect_file_handler>;
+ close $expect_file_handler;
+ # look at most recent order by the test
+ my $expect_content= pop @expect_lines;
+ chomp $expect_content;
+ if ( $expect_content =~ /^wait/ )
+ {
+ mtr_verbose("Test asks that we wait before restart");
+ # Millisceond sleep emulated with select
+ select(undef, undef, undef, (0.1));
+ next;
+ }
+ unlink($expect_file);
+ mysqld_start($mysqld, $mysqld->{'start_opts'},
+ $mysqld->{'start_slave_master_info'});
+ }
+ last;
+ }
+
+ return;
+ }
+ }
+
+ mtr_warning("check_expected_crash_and_restart couldn't find an entry for pid: $ret_pid");
+
+}
+
+##############################################################################
+#
+# The operating system will keep information about dead children,
+# we read this information here, and if we have records the process
+# is alive, we mark it as dead.
+#
+##############################################################################
+
+sub mtr_record_dead_children () {
+
+ my $process_died= 0;
+ my $ret_pid;
+
+ # Wait without blockinng to see if any processes had died
+ # -1 or 0 means there are no more procesess to wait for
+ while ( ($ret_pid= waitpid(-1,&WNOHANG)) != 0 and $ret_pid != -1)
+ {
+ mtr_warning("mtr_record_dead_children: $ret_pid");
+ mark_process_dead($ret_pid);
+ $process_died= 1;
+ }
+ return $process_died;
+}
+
+sub start_reap_all {
+ # This causes terminating processes to not become zombies, avoiding
+ # the need for (or possibility of) explicit waitpid().
+ $SIG{CHLD}= 'IGNORE';
+
+ # On some platforms (Linux, QNX, OSX, ...) there is potential race
+ # here. If a process terminated before setting $SIG{CHLD} (but after
+ # any attempt to waitpid() it), it will still be a zombie. So we
+ # have to handle any such process here.
+ my $pid;
+ while(($pid= waitpid(-1, &WNOHANG)) != 0 and $pid != -1)
+ {
+ mtr_warning("start_reap_all pid: $pid");
+ mark_process_dead($pid);
+ };
+}
+
+sub stop_reap_all {
+ $SIG{CHLD}= 'DEFAULT';
+}
+
+
+sub mtr_ping_port ($) {
+ my $port= shift;
+
+ mtr_verbose("mtr_ping_port: $port");
+
+ my $remote= "localhost";
+ my $iaddr= inet_aton($remote);
+ if ( ! $iaddr )
+ {
+ mtr_error("can't find IP number for $remote");
+ }
+ my $paddr= sockaddr_in($port, $iaddr);
+ my $proto= getprotobyname('tcp');
+ if ( ! socket(SOCK, PF_INET, SOCK_STREAM, $proto) )
+ {
+ mtr_error("can't create socket: $!");
+ }
+
+ mtr_debug("Pinging server (port: $port)...");
+
+ if ( connect(SOCK, $paddr) )
+ {
+ close(SOCK); # FIXME check error?
+ mtr_verbose("USED");
+ return 1;
+ }
+ else
+ {
+ mtr_verbose("FREE");
+ return 0;
+ }
+}
+
+##############################################################################
+#
+# Wait for a file to be created
+#
+##############################################################################
+
+# FIXME check that the pidfile contains the expected pid!
+
+sub sleep_until_file_created ($$$) {
+ my $pidfile= shift;
+ my $timeout= shift;
+ my $pid= shift;
+ my $sleeptime= 100; # Milliseconds
+ my $loops= ($timeout * 1000) / $sleeptime;
+
+ for ( my $loop= 1; $loop <= $loops; $loop++ )
+ {
+ if ( -r $pidfile )
+ {
+ return 1;
+ }
+
+ # Check if it died after the fork() was successful
+ if ( $pid != 0 && waitpid($pid,&WNOHANG) == $pid )
+ {
+ mtr_warning("Process $pid died");
+ return 0;
+ }
+
+ mtr_debug("Sleep $sleeptime milliseconds waiting for $pidfile");
+
+ # Print extra message every 60 seconds
+ my $seconds= ($loop * $sleeptime) / 1000;
+ if ( $seconds > 1 and int($seconds * 10) % 600 == 0 )
+ {
+ my $left= $timeout - $seconds;
+ mtr_warning("Waited $seconds seconds for $pidfile to be created, " .
+ "still waiting for $left seconds...");
+ }
+
+ # Millisceond sleep emulated with select
+ select(undef, undef, undef, ($sleeptime/1000));
+ }
+
+ return 0;
+}
+
+
+sub mtr_kill_processes ($) {
+ my $pids = shift;
+
+ mtr_verbose("mtr_kill_processes (" . join(" ", keys %{$pids}) . ")");
+
+ foreach my $pid (keys %{$pids})
+ {
+
+ if ($pid <= 0)
+ {
+ mtr_warning("Trying to kill illegal pid: $pid");
+ next;
+ }
+
+ my $signaled_procs= kill(9, $pid);
+ if ($signaled_procs == 0)
+ {
+ # No such process existed, assume it's killed
+ mtr_verbose("killed $pid(no such process)");
+ }
+ else
+ {
+ my $ret_pid= waitpid($pid,0);
+ if ($ret_pid == $pid)
+ {
+ mtr_verbose("killed $pid(got the pid)");
+ }
+ elsif ($ret_pid == -1)
+ {
+ mtr_verbose("killed $pid(got -1)");
+ }
+ }
+ }
+ mtr_verbose("done killing processes");
+}
+
+
+##############################################################################
+#
+# When we exit, we kill off all children
+#
+##############################################################################
+
+sub mtr_exit ($) {
+ my $code= shift;
+ mtr_timer_stop_all($::glob_timers);
+ local $SIG{HUP} = 'IGNORE';
+ # ToDo: Signalling -$$ will only work if we are the process group
+ # leader (in fact on QNX it will signal our session group leader,
+ # which might be Do-compile or Pushbuild, causing tests to be
+ # aborted). So we only do it if we are the group leader. We might
+ # set ourselves as the group leader at startup (with
+ # POSIX::setpgrp(0,0)), but then care must be needed to always do
+ # proper child process cleanup.
+ POSIX::kill(SIGHUP, -$$) if !$::glob_win32_perl and $$ == getpgrp();
+
+ exit($code);
+}
+
+###########################################################################
+
+1;
diff --git a/mysql-test/lib/v1/mtr_report.pl b/mysql-test/lib/v1/mtr_report.pl
new file mode 100644
index 00000000..8964b0f8
--- /dev/null
+++ b/mysql-test/lib/v1/mtr_report.pl
@@ -0,0 +1,589 @@
+# -*- cperl -*-
+# Copyright (c) 2004, 2010, 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-1335 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 warnings;
+
+sub mtr_report_test_name($);
+sub mtr_report_test_passed($);
+sub mtr_report_test_failed($);
+sub mtr_report_test_skipped($);
+sub mtr_report_test_not_skipped_though_disabled($);
+
+sub mtr_report_stats ($);
+sub mtr_print_line ();
+sub mtr_print_thick_line ();
+sub mtr_print_header ();
+sub mtr_report (@);
+sub mtr_warning (@);
+sub mtr_error (@);
+sub mtr_child_error (@);
+sub mtr_debug (@);
+sub mtr_verbose (@);
+
+my $tot_real_time= 0;
+
+
+
+##############################################################################
+#
+#
+#
+##############################################################################
+
+sub mtr_report_test_name ($) {
+ my $tinfo= shift;
+ my $tname= $tinfo->{name};
+
+ $tname.= " '$tinfo->{combination}'"
+ if defined $tinfo->{combination};
+
+ _mtr_log($tname);
+ printf "%-30s ", $tname;
+}
+
+sub mtr_report_test_skipped ($) {
+ my $tinfo= shift;
+
+ $tinfo->{'result'}= 'MTR_RES_SKIPPED';
+ if ( $tinfo->{'disable'} )
+ {
+ mtr_report("[ disabled ] $tinfo->{'comment'}");
+ }
+ elsif ( $tinfo->{'comment'} )
+ {
+ mtr_report("[ skipped ] $tinfo->{'comment'}");
+ }
+ else
+ {
+ mtr_report("[ skipped ]");
+ }
+}
+
+sub mtr_report_tests_not_skipped_though_disabled ($) {
+ my $tests= shift;
+
+ if ( $::opt_enable_disabled )
+ {
+ my @disabled_tests= grep {$_->{'dont_skip_though_disabled'}} @$tests;
+ if ( @disabled_tests )
+ {
+ print "\nTest(s) which will be run though they are marked as disabled:\n";
+ foreach my $tinfo ( sort {$a->{'name'} cmp $b->{'name'}} @disabled_tests )
+ {
+ printf " %-20s : %s\n", $tinfo->{'name'}, $tinfo->{'comment'};
+ }
+ }
+ }
+}
+
+sub mtr_report_test_passed ($) {
+ my $tinfo= shift;
+
+ my $timer= "";
+ if ( $::opt_timer and -f "$::opt_vardir/log/timer" )
+ {
+ $timer= mtr_fromfile("$::opt_vardir/log/timer");
+ $tot_real_time += ($timer/1000);
+ $timer= sprintf "%12s", $timer;
+ }
+ $tinfo->{'result'}= 'MTR_RES_PASSED';
+ mtr_report("[ pass ] $timer");
+}
+
+sub mtr_report_test_failed ($) {
+ my $tinfo= shift;
+
+ $tinfo->{'result'}= 'MTR_RES_FAILED';
+ 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 ( -f $::path_timefile )
+ {
+ # Test failure was detected by test tool and it's report
+ # about what failed has been saved to file. Display the report.
+ print "\n";
+ print mtr_fromfile($::path_timefile); # FIXME print_file() instead
+ print "\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");;
+ }
+}
+
+sub mtr_report_stats ($) {
+ my $tests= shift;
+
+ # ----------------------------------------------------------------------
+ # Find out how we where doing
+ # ----------------------------------------------------------------------
+
+ my $tot_skiped= 0;
+ my $tot_passed= 0;
+ my $tot_failed= 0;
+ my $tot_tests= 0;
+ my $tot_restarts= 0;
+ my $found_problems= 0; # Some warnings in the logfiles are errors...
+
+ foreach my $tinfo (@$tests)
+ {
+ if ( $tinfo->{'result'} eq 'MTR_RES_SKIPPED' )
+ {
+ $tot_skiped++;
+ }
+ elsif ( $tinfo->{'result'} eq 'MTR_RES_PASSED' )
+ {
+ $tot_tests++;
+ $tot_passed++;
+ }
+ elsif ( $tinfo->{'result'} eq 'MTR_RES_FAILED' )
+ {
+ $tot_tests++;
+ $tot_failed++;
+ }
+ if ( $tinfo->{'restarted'} )
+ {
+ $tot_restarts++;
+ }
+ }
+
+ # ----------------------------------------------------------------------
+ # Print out a summary report to screen
+ # ----------------------------------------------------------------------
+
+ if ( ! $tot_failed )
+ {
+ print "All $tot_tests tests were successful.\n";
+ }
+ else
+ {
+ my $ratio= $tot_passed * 100 / $tot_tests;
+ print "Failed $tot_failed/$tot_tests tests, ";
+ printf("%.2f", $ratio);
+ print "\% were successful.\n\n";
+ print
+ "The log files in var/log may give you some hint\n",
+ "of what went wrong.\n",
+ "If you want to report this error, please read first ",
+ "the documentation at\n",
+ "http://dev.mysql.com/doc/mysql/en/mysql-test-suite.html\n";
+ }
+ if (!$::opt_extern)
+ {
+ print "The servers were restarted $tot_restarts times\n";
+ }
+
+ if ( $::opt_timer )
+ {
+ use English;
+
+ mtr_report("Spent", sprintf("%.3f", $tot_real_time),"of",
+ time - $BASETIME, "seconds executing testcases");
+ }
+
+ # ----------------------------------------------------------------------
+ # If a debug run, there might be interesting information inside
+ # the "var/log/*.err" files. We save this info in "var/log/warnings"
+ # ----------------------------------------------------------------------
+
+ if ( ! $::glob_use_running_server && !$::opt_extern)
+ {
+ # Save and report if there was any fatal warnings/errors in err logs
+
+ my $warnlog= "$::opt_vardir/log/warnings";
+
+ unless ( open(WARN, ">$warnlog") )
+ {
+ mtr_warning("can't write to the file \"$warnlog\": $!");
+ }
+ else
+ {
+ # We report different types of problems in order
+ foreach my $pattern ( "^Warning:",
+ "\\[Warning\\]",
+ "\\[ERROR\\]",
+ "^Error:", "^==.* at 0x",
+ "InnoDB: Warning",
+ "InnoDB: Error",
+ "^safe_mutex:",
+ "missing DBUG_RETURN",
+ "mysqld: Warning",
+ "allocated at line",
+ "Attempting backtrace", "Assertion .* failed" )
+ {
+ foreach my $errlog ( sort glob("$::opt_vardir/log/*.err") )
+ {
+ my $testname= "";
+ unless ( open(ERR, $errlog) )
+ {
+ mtr_warning("can't read $errlog");
+ next;
+ }
+ while ( <ERR> )
+ {
+ # Skip some non fatal warnings from the log files
+ if (
+ /\"SELECT UNIX_TIMESTAMP\(\)\" failed on master/ or
+ /Aborted connection/ or
+ /Client requested master to start replication from impossible position/ or
+ /Could not find first log file name in binary log/ or
+ /Enabling keys got errno/ or
+ /Error reading master configuration/ or
+ /Error reading packet/ or
+ /Event Scheduler/ or
+ /Failed to open log/ or
+ /Failed to open the existing master info file/ or
+ /Forcing shutdown of [0-9]* plugins/ or
+ /Can't open shared library .*\bha_example\b/ or
+ /Couldn't load plugin .*\bha_example\b/ or
+
+ # Due to timing issues, it might be that this warning
+ # is printed when the server shuts down and the
+ # computer is loaded.
+ /Forcing close of thread \d+ user: '.*?'/ or
+
+ /Got error [0-9]* when reading table/ or
+ /Incorrect definition of table/ or
+ /Incorrect information in file/ or
+ /InnoDB: Warning: we did not need to do crash recovery/ or
+ /Invalid \(old\?\) table or database name/ or
+ /Lock wait timeout exceeded/ or
+ /Log entry on master is longer than max_allowed_packet/ or
+ /unknown option '--loose-/ or
+ /unknown variable 'loose-/ or
+ /You have forced lower_case_table_names to 0 through a command-line option/ or
+ /Setting lower_case_table_names=2/ or
+ /Neither --relay-log nor --relay-log-index were used/ or
+ /Query partially completed/ or
+ /Slave I.O thread aborted while waiting for relay log/ or
+ /Slave SQL thread is stopped because UNTIL condition/ or
+ /Slave SQL thread retried transaction/ or
+ /Slave \(additional info\)/ or
+ /Slave: .*Duplicate column name/ or
+ /Slave: .*master may suffer from/ or
+ /Slave: According to the master's version/ or
+ /Slave: Column [0-9]* type mismatch/ or
+ /Slave: Error .* doesn't exist/ or
+ /Slave: Deadlock found/ or
+ /Slave: Error .*Unknown table/ or
+ /Slave: Error in Write_rows event: / or
+ /Slave: Field .* of table .* has no default value/ or
+ /Slave: Field .* doesn't have a default value/ or
+ /Slave: Query caused different errors on master and slave/ or
+ /Slave: Table .* doesn't exist/ or
+ /Slave: Table width mismatch/ or
+ /Slave: The incident LOST_EVENTS occurred on the master/ or
+ /Slave: Unknown error.* 1105/ or
+ /Slave: Can't drop database.* database doesn't exist/ or
+ /Slave SQL:.*(?:error.* \d+|Query:.*)/ or
+ /Sort aborted/ or
+ /One can only use the --user.*root/ or
+ /Table:.* on (delete|rename)/ or
+ /You have an error in your SQL syntax/ or
+ /deprecated/ or
+ /description of time zone/ or
+ /equal MySQL server ids/ or
+ /error .*connecting to master/ or
+ /error reading log entry/ or
+ /lower_case_table_names is set/ or
+ /skip-name-resolve mode/ or
+ /slave SQL thread aborted/ or
+ /Slave: .*Duplicate entry/ or
+ # Special case for Bug #26402 in show_check.test
+ # Question marks are not valid file name parts
+ # on Windows platforms. Ignore this error message.
+ /\QCan't find file: '.\test\????????.frm'\E/ or
+ # Special case, made as specific as possible, for:
+ # Bug #28436: Incorrect position in SHOW BINLOG EVENTS causes
+ # server coredump
+ /\QError in Log_event::read_log_event(): 'Sanity check failed', data_len: 258, event_type: 49\E/ or
+ /Statement is not safe to log in statement format/ or
+
+ # test case for Bug#bug29807 copies a stray frm into database
+ /InnoDB: Error: table `test`.`bug29807` does not exist in the InnoDB internal/ or
+ /Cannot find or open table test\/bug29807 from/ or
+
+ # innodb foreign key tests that fail in ALTER or RENAME produce this
+ /InnoDB: Error: in ALTER TABLE `test`.`t[12]`/ or
+ /InnoDB: Error: in RENAME TABLE table `test`.`t1`/ or
+ /InnoDB: Error: table `test`.`t[12]` does not exist in the InnoDB internal/ or
+
+ # Test case for Bug#14233 produces the following warnings:
+ /Stored routine 'test'.'bug14233_1': invalid value in column mysql.proc/ or
+ /Stored routine 'test'.'bug14233_2': invalid value in column mysql.proc/ or
+ /Stored routine 'test'.'bug14233_3': invalid value in column mysql.proc/ or
+
+ # BUG#29839 - lowercase_table3.test: Cannot find table test/T1
+ # from the internal data dictiona
+ /Cannot find table test\/BUG29839 from the internal data dictionary/ or
+ # BUG#32080 - Excessive warnings on Solaris: setrlimit could not
+ # change the size of core files
+ /setrlimit could not change the size of core files to 'infinity'/ or
+
+ # rpl_extrColmaster_*.test, the slave thread produces warnings
+ # when it get updates to a table that has more columns on the
+ # master
+ /Slave: Unknown column 'c7' in 't15' error.* 1054/ or
+ /Slave: Can't DROP 'c7'.* 1091/ or
+ /Slave: Key column 'c6'.* 1072/ or
+
+ # rpl_idempotency.test produces warnings for the slave.
+ ($testname eq 'rpl.rpl_idempotency' and
+ (/Slave: Can\'t find record in \'t1\' error.* 1032/ or
+ /Slave: Cannot add or update a child row: a foreign key constraint fails .* error.* 1452/
+ )) or
+
+ # These tests does "kill" on queries, causing sporadic errors when writing to logs
+ (($testname eq 'rpl.rpl_skip_error' or
+ $testname eq 'rpl.rpl_err_ignoredtable' or
+ $testname eq 'binlog.binlog_killed_simulate' or
+ $testname eq 'binlog.binlog_killed') and
+ (/Failed to write to mysql\.\w+_log/
+ )) or
+
+ # rpl_bug33931 has deliberate failures
+ ($testname eq 'rpl.rpl_bug33931' and
+ (/Failed during slave.*thread initialization/
+ )) or
+
+ # rpl_temporary has an error on slave that can be ignored
+ ($testname eq 'rpl.rpl_temporary' and
+ (/Slave: Can\'t find record in \'user\' error.* 1032/
+ )) or
+ # Test case for Bug#31590 produces the following error:
+ /Out of sort memory; increase server sort buffer size/ or
+
+ # Bug#35161, test of auto repair --myisam-recover
+ /able.*_will_crash/ or
+
+ # lowercase_table3 using case sensitive option on
+ # case insensitive filesystem (InnoDB error).
+ /Cannot find or open table test\/BUG29839 from/ or
+
+ # When trying to set lower_case_table_names = 2
+ # on a case sensitive file system. Bug#37402.
+ /lower_case_table_names was set to 2, even though your the file system '.*' is case sensitive. Now setting lower_case_table_names to 0 to avoid future problems./ or
+
+ # maria-recovery.test has warning about missing log file
+ /File '.*maria_log.000.*' not found \(Errcode: 2\)/ or
+ # and about marked-corrupted table
+ /Table '..mysqltest.t_corrupted1' is crashed, skipping it. Please repair it with maria_chk -r/ or
+ # maria-recover.test corrupts tables on purpose
+ /Checking table: '..mysqltest.t_corrupted2'/ or
+ /Recovering table: '..mysqltest.t_corrupted2'/ or
+ /Table '..mysqltest.t_corrupted2' is marked as crashed and should be repaired/ or
+ /Incorrect key file for table '..mysqltest.t_corrupted2.MAI'; try to repair it/
+ )
+ {
+ next; # Skip these lines
+ }
+ if ( /CURRENT_TEST: (.*)/ )
+ {
+ $testname= $1;
+ }
+ if ( /$pattern/ )
+ {
+ $found_problems= 1;
+ print WARN basename($errlog) . ": $testname: $_";
+ }
+ }
+ }
+ }
+
+ if ( $::opt_check_testcases )
+ {
+ # Look for warnings produced by mysqltest in testname.warnings
+ foreach my $test_warning_file
+ ( glob("$::glob_mysql_test_dir/r/*.warnings") )
+ {
+ $found_problems= 1;
+ print WARN "Check myqltest warnings in $test_warning_file\n";
+ }
+ }
+
+ if ( $found_problems )
+ {
+ mtr_warning("Got errors/warnings while running tests, please examine",
+ "\"$warnlog\" for details.");
+ }
+ }
+ }
+
+ print "\n";
+
+ # Print a list of testcases that failed
+ if ( $tot_failed != 0 )
+ {
+ my $test_mode= join(" ", @::glob_test_mode) || "default";
+ print "mysql-test-run in $test_mode mode: *** Failing the test(s):";
+
+ foreach my $tinfo (@$tests)
+ {
+ if ( $tinfo->{'result'} eq 'MTR_RES_FAILED' )
+ {
+ print " $tinfo->{'name'}";
+ }
+ }
+ print "\n";
+
+ }
+
+ # Print a list of check_testcases that failed(if any)
+ if ( $::opt_check_testcases )
+ {
+ my @check_testcases= ();
+
+ foreach my $tinfo (@$tests)
+ {
+ if ( defined $tinfo->{'check_testcase_failed'} )
+ {
+ push(@check_testcases, $tinfo->{'name'});
+ }
+ }
+
+ if ( @check_testcases )
+ {
+ print "Check of testcase failed for: ";
+ print join(" ", @check_testcases);
+ print "\n\n";
+ }
+ }
+
+ if ( $tot_failed != 0 || $found_problems)
+ {
+ mtr_error("there were failing test cases");
+ }
+}
+
+##############################################################################
+#
+# Text formatting
+#
+##############################################################################
+
+sub mtr_print_line () {
+ print '-' x 55, "\n";
+}
+
+sub mtr_print_thick_line () {
+ print '=' x 55, "\n";
+}
+
+sub mtr_print_header () {
+ print "\n";
+ if ( $::opt_timer )
+ {
+ print "TEST RESULT TIME (ms)\n";
+ }
+ else
+ {
+ print "TEST RESULT\n";
+ }
+ mtr_print_line();
+ print "\n";
+}
+
+
+##############################################################################
+#
+# Log and reporting functions
+#
+##############################################################################
+
+use IO::File;
+
+my $log_file_ref= undef;
+
+sub mtr_log_init ($) {
+ my ($filename)= @_;
+
+ mtr_error("Log is already open") if defined $log_file_ref;
+
+ $log_file_ref= IO::File->new($filename, "a") or
+ mtr_warning("Could not create logfile $filename: $!");
+}
+
+sub _mtr_log (@) {
+ print $log_file_ref join(" ", @_),"\n"
+ if defined $log_file_ref;
+}
+
+sub mtr_report (@) {
+ # Print message to screen and log
+ _mtr_log(@_);
+ print join(" ", @_),"\n";
+}
+
+sub mtr_warning (@) {
+ # Print message to screen and log
+ _mtr_log("WARNING: ", @_);
+ print STDERR "mysql-test-run: WARNING: ",join(" ", @_),"\n";
+}
+
+sub mtr_error (@) {
+ # Print message to screen and log
+ _mtr_log("ERROR: ", @_);
+ print STDERR "mysql-test-run: *** ERROR: ",join(" ", @_),"\n";
+ mtr_exit(1);
+}
+
+sub mtr_child_error (@) {
+ # Print message to screen and log
+ _mtr_log("ERROR(child): ", @_);
+ print STDERR "mysql-test-run: *** ERROR(child): ",join(" ", @_),"\n";
+ exit(1);
+}
+
+sub mtr_debug (@) {
+ # Only print if --script-debug is used
+ if ( $::opt_script_debug )
+ {
+ _mtr_log("###: ", @_);
+ print STDERR "####: ",join(" ", @_),"\n";
+ }
+}
+
+sub mtr_verbose (@) {
+ # Always print to log, print to screen only when --verbose is used
+ _mtr_log("> ",@_);
+ if ( $::opt_verbose )
+ {
+ print STDERR "> ",join(" ", @_),"\n";
+ }
+}
+
+1;
diff --git a/mysql-test/lib/v1/mtr_stress.pl b/mysql-test/lib/v1/mtr_stress.pl
new file mode 100644
index 00000000..c96469a5
--- /dev/null
+++ b/mysql-test/lib/v1/mtr_stress.pl
@@ -0,0 +1,192 @@
+# -*- cperl -*-
+# Copyright (c) 2006 MySQL AB, 2008, 2009 Sun Microsystems, Inc.
+# Use is subject to license terms.
+#
+# 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-1335 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 mariadbd 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=1");
+
+ 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/mariadb-stress-test.pl", $args, "", "", "", "");
+ if ( ! $::glob_use_embedded_server )
+ {
+ stop_all_servers();
+ }
+}
+
+1;
diff --git a/mysql-test/lib/v1/mtr_timer.pl b/mysql-test/lib/v1/mtr_timer.pl
new file mode 100644
index 00000000..98dc27b3
--- /dev/null
+++ b/mysql-test/lib/v1/mtr_timer.pl
@@ -0,0 +1,159 @@
+# -*- cperl -*-
+# Copyright (c) 2005, 2006 MySQL AB, 2008 Sun Microsystems, Inc.
+# Use is subject to license terms.
+#
+# 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-1335 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 Errno;
+use strict;
+
+sub mtr_init_timers ();
+sub mtr_timer_start($$$);
+sub mtr_timer_stop($$);
+sub mtr_timer_stop_all($);
+
+
+##############################################################################
+#
+# Initiate the structure shared by all timers
+#
+##############################################################################
+
+sub mtr_init_timers () {
+ my $timers = { timers => {}, pids => {}};
+ return $timers;
+}
+
+
+##############################################################################
+#
+# Start, stop and poll a timer
+#
+# As alarm() isn't portable to Windows, we use separate processes to
+# implement timers.
+#
+##############################################################################
+
+sub mtr_timer_start($$$) {
+ my ($timers,$name,$duration)= @_;
+
+ if ( exists $timers->{'timers'}->{$name} )
+ {
+ # We have an old running timer, kill it
+ mtr_warning("There is an old timer running");
+ mtr_timer_stop($timers,$name);
+ }
+
+ FORK:
+ {
+ my $tpid= fork();
+
+ if ( ! defined $tpid )
+ {
+ if ( $! == $!{EAGAIN} ) # See "perldoc Errno"
+ {
+ mtr_warning("Got EAGAIN from fork(), sleep 1 second and redo");
+ sleep(1);
+ redo FORK;
+ }
+ else
+ {
+ mtr_error("can't fork timer, error: $!");
+ }
+ }
+
+ if ( $tpid )
+ {
+ # Parent, record the information
+ mtr_verbose2("Starting timer for '$name',",
+ "duration: $duration, pid: $tpid");
+ $timers->{'timers'}->{$name}->{'pid'}= $tpid;
+ $timers->{'timers'}->{$name}->{'duration'}= $duration;
+ $timers->{'pids'}->{$tpid}= $name;
+ }
+ else
+ {
+ # Child, install signal handlers and sleep for "duration"
+
+ # Don't do the ^C cleanup in the timeout child processes!
+ # There is actually a race here, if we get ^C after fork(), but before
+ # clearing the signal handler.
+ $SIG{INT}= 'DEFAULT';
+
+ $SIG{TERM}= sub {
+ mtr_verbose2("timer $$ woke up, exiting!");
+ exit(0);
+ };
+
+ $0= "mtr_timer(timers,$name,$duration)";
+ sleep($duration);
+ mtr_verbose2("timer $$ expired after $duration seconds");
+ exit(0);
+ }
+ }
+}
+
+
+sub mtr_timer_stop ($$) {
+ my ($timers,$name)= @_;
+
+ if ( exists $timers->{'timers'}->{$name} )
+ {
+ my $tpid= $timers->{'timers'}->{$name}->{'pid'};
+ mtr_verbose("Stopping timer for '$name' with pid $tpid");
+
+ # FIXME as Cygwin reuses pids fast, maybe check that is
+ # the expected process somehow?!
+ kill(15, $tpid);
+
+ # As the timers are so simple programs, we trust them to terminate,
+ # and use blocking wait for it. We wait just to avoid a zombie.
+ waitpid($tpid,0);
+
+ delete $timers->{'timers'}->{$name}; # Remove the timer information
+ delete $timers->{'pids'}->{$tpid}; # and PID reference
+
+ return 1;
+ }
+
+ mtr_error("Asked to stop timer '$name' not started");
+}
+
+
+sub mtr_timer_stop_all ($) {
+ my $timers= shift;
+
+ foreach my $name ( keys %{$timers->{'timers'}} )
+ {
+ mtr_timer_stop($timers, $name);
+ }
+ return 1;
+}
+
+
+sub mtr_timer_timeout ($$) {
+ my ($timers,$pid)= @_;
+
+ return "" unless exists $timers->{'pids'}->{$pid};
+
+ # Got a timeout(the process with $pid is recorded as being a timer)
+ # return the name of the timer
+ return $timers->{'pids'}->{$pid};
+}
+
+1;
diff --git a/mysql-test/lib/v1/mtr_unique.pl b/mysql-test/lib/v1/mtr_unique.pl
new file mode 100644
index 00000000..b9ed9138
--- /dev/null
+++ b/mysql-test/lib/v1/mtr_unique.pl
@@ -0,0 +1,179 @@
+# -*- cperl -*-
+# Copyright (c) 2006 MySQL AB, 2008 Sun Microsystems, Inc.
+# Use is subject to license terms.
+#
+# 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-1335 USA
+
+#
+# This file is used from mysql-test-run.pl when choosing
+# port numbers and directories to use for running mysqld.
+#
+
+use strict;
+use Fcntl ':flock';
+
+#
+# Requested IDs are stored in a hash and released upon END.
+#
+my %mtr_unique_assigned_ids = ();
+my $mtr_unique_pid;
+BEGIN {
+ $mtr_unique_pid = $$ unless defined $mtr_unique_pid;
+}
+END {
+ if($mtr_unique_pid == $$) {
+ while(my ($id,$file) = each(%mtr_unique_assigned_ids)) {
+ print "Autoreleasing $file:$id\n";
+ mtr_release_unique_id($file, $id);
+ }
+ }
+}
+
+#
+# Require a unique, numerical ID, given a file name (where all
+# requested IDs are stored), a minimum and a maximum value.
+#
+# We use flock to implement locking for the ID file and ignore
+# possible problems arising from lack of support for it on
+# some platforms (it should work on most, and the possible
+# race condition would occur rarely). The proper solution for
+# this is a daemon that manages IDs, of course.
+#
+# If no unique ID within the specified parameters can be
+# obtained, return undef.
+#
+sub mtr_require_unique_id($$$) {
+ my $file = shift;
+ my $min = shift;
+ my $max = shift;
+ my $ret = undef;
+ my $changed = 0;
+
+ my $can_use_ps = `ps -e | grep '^[ ]*$$ '`;
+
+ if(eval("readlink '$file'") || eval("readlink '$file.sem'")) {
+ die 'lock file is a symbolic link';
+ }
+
+ chmod 0777, "$file.sem";
+ open SEM, ">", "$file.sem" or die "can't write to $file.sem";
+ flock SEM, LOCK_EX or die "can't lock $file.sem";
+ if(! -e $file) {
+ open FILE, ">", $file or die "can't create $file";
+ close FILE;
+ }
+
+ if(eval("readlink '$file'") || eval("readlink '$file.sem'")) {
+ die 'lock file is a symbolic link';
+ }
+
+ chmod 0777, $file;
+ open FILE, "+<", $file or die "can't open $file";
+ select undef,undef,undef,0.2;
+ seek FILE, 0, 0;
+ my %taken = ();
+ while(<FILE>) {
+ chomp;
+ my ($id, $pid) = split / /;
+ $taken{$id} = $pid;
+ if($can_use_ps) {
+ my $res = `ps -e | grep '^[ ]*$pid '`;
+ if(!$res) {
+ print "Ignoring slot $id used by missing process $pid.\n";
+ delete $taken{$id};
+ ++$changed;
+ }
+ }
+ }
+ for(my $i=$min; $i<=$max; ++$i) {
+ if(! exists $taken{$i}) {
+ $ret = $i;
+ $taken{$i} = $$;
+ ++$changed;
+ last;
+ }
+ }
+ if($changed) {
+ seek FILE, 0, 0;
+ truncate FILE, 0 or die "can't truncate $file";
+ for my $k (keys %taken) {
+ print FILE $k . ' ' . $taken{$k} . "\n";
+ }
+ }
+ close FILE;
+ flock SEM, LOCK_UN or warn "can't unlock $file.sem";
+ close SEM;
+ $mtr_unique_assigned_ids{$ret} = $file if defined $ret;
+ return $ret;
+}
+
+#
+# Require a unique ID like above, but sleep if no ID can be
+# obtained immediately.
+#
+sub mtr_require_unique_id_and_wait($$$) {
+ my $ret = mtr_require_unique_id($_[0],$_[1],$_[2]);
+ while(! defined $ret) {
+ sleep 30;
+ $ret = mtr_require_unique_id($_[0],$_[1],$_[2]);
+ print "Waiting for unique id to become available...\n" unless $ret;
+ }
+ return $ret;
+}
+
+#
+# Release a unique ID.
+#
+sub mtr_release_unique_id($$) {
+ my $file = shift;
+ my $myid = shift;
+
+ if(eval("readlink '$file'") || eval("readlink '$file.sem'")) {
+ die 'lock file is a symbolic link';
+ }
+
+ open SEM, ">", "$file.sem" or die "can't write to $file.sem";
+ flock SEM, LOCK_EX or die "can't lock $file.sem";
+
+ if(eval("readlink '$file'") || eval("readlink '$file.sem'")) {
+ die 'lock file is a symbolic link';
+ }
+
+ if(! -e $file) {
+ open FILE, ">", $file or die "can't create $file";
+ close FILE;
+ }
+ open FILE, "+<", $file or die "can't open $file";
+ select undef,undef,undef,0.2;
+ seek FILE, 0, 0;
+ my %taken = ();
+ while(<FILE>) {
+ chomp;
+ my ($id, $pid) = split / /;
+ $taken{$id} = $pid;
+ }
+ delete $taken{$myid};
+ seek FILE, 0, 0;
+ truncate FILE, 0 or die "can't truncate $file";
+ for my $k (keys %taken) {
+ print FILE $k . ' ' . $taken{$k} . "\n";
+ }
+ close FILE;
+ flock SEM, LOCK_UN or warn "can't unlock $file.sem";
+ close SEM;
+ delete $mtr_unique_assigned_ids{$myid};
+}
+
+1;
+
diff --git a/mysql-test/lib/v1/mysql-test-run.pl b/mysql-test/lib/v1/mysql-test-run.pl
new file mode 100755
index 00000000..aabe3d75
--- /dev/null
+++ b/mysql-test/lib/v1/mysql-test-run.pl
@@ -0,0 +1,4324 @@
+#!/usr/bin/env perl
+# -*- cperl -*-
+
+# Copyright (c) 2008, 2013, 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-1335 USA
+
+##############################################################################
+#
+# mysql-test-run.pl
+#
+# Tool used for executing a suite of .test file
+#
+# See the "MySQL Test framework manual" for more information
+# https://mariadb.com/kb/en/library/mysqltest/
+#
+# Please keep the test framework tools identical in all versions!
+#
+##############################################################################
+#
+# Coding style directions for this perl script
+#
+# - To make this Perl script easy to alter even for those that not
+# code Perl that often, keeep the coding style as close as possible to
+# the C/C++ MySQL coding standard.
+#
+# - All lists of arguments to send to commands are Perl lists/arrays,
+# not strings we append args to. Within reason, most string
+# concatenation for arguments should be avoided.
+#
+# - Functions defined in the main program are not to be prefixed,
+# functions in "library files" are to be prefixed with "mtr_" (for
+# Mysql-Test-Run). There are some exceptions, code that fits best in
+# the main program, but are put into separate files to avoid
+# clutter, may be without prefix.
+#
+# - All stat/opendir/-f/ is to be kept in collect_test_cases(). It
+# will create a struct that the rest of the program can use to get
+# the information. This separates the "find information" from the
+# "do the work" and makes the program more easy to maintain.
+#
+# - The rule when it comes to the logic of this program is
+#
+# command_line_setup() - is to handle the logic between flags
+# collect_test_cases() - is to do its best to select what tests
+# to run, dig out options, if needs restart etc.
+# run_testcase() - is to run a single testcase, and follow the
+# logic set in both above. No, or rare file
+# system operations. If a test seems complex,
+# it should probably not be here.
+#
+# A nice way to trace the execution of this script while debugging
+# is to use the Devel::Trace package found at
+# "http://www.plover.com/~mjd/perl/Trace/" and run this script like
+# "perl -d:Trace mysql-test-run.pl"
+#
+
+
+use lib "lib/v1/";
+
+$Devel::Trace::TRACE= 0; # Don't trace boring init stuff
+
+#require 5.6.1;
+use File::Path;
+use File::Basename;
+use File::Copy;
+use File::Temp qw /tempdir/;
+use File::Spec::Functions qw /splitdir/;
+use Cwd;
+use Getopt::Long;
+use IO::Socket;
+use IO::Socket::INET;
+use strict;
+use warnings;
+
+select(STDOUT);
+$| = 1; # Automatically flush STDOUT
+
+our $glob_win32_perl= ($^O eq "MSWin32"); # ActiveState Win32 Perl
+our $glob_cygwin_perl= ($^O eq "cygwin"); # Cygwin Perl
+our $glob_win32= ($glob_win32_perl or $glob_cygwin_perl);
+
+require "lib/v1/mtr_cases.pl";
+require "lib/v1/mtr_process.pl";
+require "lib/v1/mtr_timer.pl";
+require "lib/v1/mtr_io.pl";
+require "lib/v1/mtr_gcov.pl";
+require "lib/v1/mtr_gprof.pl";
+require "lib/v1/mtr_report.pl";
+require "lib/v1/mtr_match.pl";
+require "lib/v1/mtr_misc.pl";
+require "lib/v1/mtr_stress.pl";
+require "lib/v1/mtr_unique.pl";
+
+$Devel::Trace::TRACE= 1;
+
+##############################################################################
+#
+# Default settings
+#
+##############################################################################
+
+# Misc global variables
+our $mysql_version_id;
+our $glob_mysql_test_dir= undef;
+our $glob_mysql_bench_dir= undef;
+our $glob_scriptname= undef;
+our $glob_timers= undef;
+our $glob_use_embedded_server= 0;
+our @glob_test_mode;
+
+our $glob_basedir;
+our $glob_bindir;
+
+our $path_charsetsdir;
+our $path_client_bindir;
+our $path_client_libdir;
+our $path_share;
+our $path_language;
+our $path_timefile;
+our $path_snapshot;
+our $path_mysqltest_log;
+our $path_current_test_log;
+
+our $opt_vardir; # A path but set directly on cmd line
+our $path_vardir_trace; # unix formatted opt_vardir for trace files
+our $opt_tmpdir; # A path but set directly on cmd line
+
+# Visual Studio produces executables in different sub-directories based on the
+# configuration used to build them. To make life easier, an environment
+# variable or command-line option may be specified to control which set of
+# executables will be used by the test suite.
+our $multiconfig = $ENV{'MTR_VS_CONFIG'};
+
+our $default_vardir;
+
+our $opt_usage;
+our $opt_list_options;
+our $opt_suites;
+our $opt_suites_default= "main,binlog,rpl,maria"; # Default suites to run
+our $opt_script_debug= 0; # Script debugging, enable with --script-debug
+our $opt_verbose= 0; # Verbose output, enable with --verbose
+
+our $exe_master_mysqld;
+our $exe_mysql;
+our $exe_mysqladmin;
+our $exe_mysql_upgrade;
+our $exe_mysqlbinlog;
+our $exe_mysql_client_test;
+our $exe_bug25714;
+our $exe_mysqld;
+our $exe_mysqlcheck;
+our $exe_mysqldump;
+our $exe_mysqlslap;
+our $exe_mysqlimport;
+our $exe_mysqlshow;
+our $file_mysql_fix_privilege_tables;
+our $exe_mysqltest;
+our $exe_slave_mysqld;
+our $exe_my_print_defaults;
+our $exe_perror;
+our $lib_udf_example;
+our $lib_example_plugin;
+our $exe_libtool;
+
+our $opt_bench= 0;
+our $opt_small_bench= 0;
+our $opt_big_test= 0;
+
+our @opt_combinations;
+our $opt_skip_combination;
+
+our @opt_extra_mysqld_opt;
+our @opt_extra_mysqltest_opt;
+
+our $opt_compress;
+our $opt_ssl;
+our $opt_skip_ssl;
+our $opt_ssl_supported;
+our $opt_ps_protocol;
+our $opt_sp_protocol;
+our $opt_cursor_protocol;
+our $opt_view_protocol;
+
+our $opt_debug;
+our $opt_do_test;
+our @opt_cases; # The test cases names in argv
+our $opt_embedded_server;
+
+our $opt_extern= 0;
+our $opt_socket;
+
+our $opt_fast;
+our $opt_force;
+our $opt_reorder= 0;
+our $opt_enable_disabled;
+our $opt_mem= $ENV{'MTR_MEM'};
+
+our $opt_gcov;
+our $opt_gcov_err;
+our $opt_gcov_msg;
+
+our $glob_debugger= 0;
+our $opt_gdb;
+our $opt_client_gdb;
+our $opt_ddd;
+our $opt_client_ddd;
+our $opt_manual_gdb;
+our $opt_manual_ddd;
+our $opt_manual_debug;
+our $opt_mtr_build_thread=0;
+our $opt_debugger;
+our $opt_client_debugger;
+
+our $opt_gprof;
+our $opt_gprof_dir;
+our $opt_gprof_master;
+our $opt_gprof_slave;
+
+our $master;
+our $slave;
+
+our $opt_master_myport;
+our $opt_slave_myport;
+
+our $opt_record;
+my $opt_report_features;
+our $opt_check_testcases;
+our $opt_mark_progress;
+
+our $opt_skip_rpl;
+our $max_slave_num= 0;
+our $max_master_num= 1;
+our $use_innodb;
+our $opt_skip_test;
+
+our $opt_sleep;
+
+our $opt_testcase_timeout;
+our $opt_suite_timeout;
+my $default_testcase_timeout= 15; # 15 min max
+my $default_suite_timeout= 300; # 5 hours max
+
+our $opt_start_and_exit;
+our $opt_start_dirty;
+our $opt_start_from;
+
+our $opt_strace_client;
+
+our $opt_timer= 1;
+
+our $opt_user;
+
+my $opt_valgrind= 0;
+my $opt_valgrind_mysqld= 0;
+my $opt_valgrind_mysqltest= 0;
+my @default_valgrind_args= ("--show-reachable=yes");
+my @valgrind_args;
+my $opt_valgrind_path;
+my $opt_callgrind;
+
+our $opt_stress= "";
+our $opt_stress_suite= "main";
+our $opt_stress_mode= "random";
+our $opt_stress_threads= 5;
+our $opt_stress_test_count= 0;
+our $opt_stress_loop_count= 0;
+our $opt_stress_test_duration= 0;
+our $opt_stress_init_file= "";
+our $opt_stress_test_file= "";
+
+our $opt_warnings;
+
+our $opt_skip_master_binlog= 0;
+our $opt_skip_slave_binlog= 0;
+
+our $path_sql_dir;
+
+our @data_dir_lst;
+
+our $used_binlog_format;
+our $used_default_engine;
+our $debug_compiled_binaries;
+
+our %mysqld_variables;
+
+my $source_dist= 0;
+
+our $opt_max_save_core= 5;
+my $num_saved_cores= 0; # Number of core files saved in vardir/log/ so far.
+
+######################################################################
+#
+# Function declarations
+#
+######################################################################
+
+sub main ();
+sub initial_setup ();
+sub command_line_setup ();
+sub set_mtr_build_thread_ports($);
+sub datadir_list_setup ();
+sub executable_setup ();
+sub environment_setup ();
+sub kill_running_servers ();
+sub remove_stale_vardir ();
+sub setup_vardir ();
+sub check_ssl_support ($);
+sub check_running_as_root();
+sub mysqld_wait_started($);
+sub run_benchmarks ($);
+sub initialize_servers ();
+sub mysql_install_db ();
+sub install_db ($$);
+sub copy_install_db ($$);
+sub run_testcase ($);
+sub run_testcase_stop_servers ($$$);
+sub run_testcase_start_servers ($);
+sub run_testcase_check_skip_test($);
+sub report_failure_and_restart ($);
+sub do_before_start_master ($);
+sub do_before_start_slave ($);
+sub mysqld_start ($$$);
+sub mysqld_arguments ($$$$);
+sub stop_all_servers ();
+sub run_mysqltest ($);
+sub usage ($);
+
+
+######################################################################
+#
+# Main program
+#
+######################################################################
+
+main();
+
+sub main () {
+
+ command_line_setup();
+
+ check_ssl_support(\%mysqld_variables);
+ check_debug_support(\%mysqld_variables);
+
+ executable_setup();
+
+ environment_setup();
+ signal_setup();
+
+ if ( $opt_gcov )
+ {
+ gcov_prepare();
+ }
+
+ if ( $opt_gprof )
+ {
+ gprof_prepare();
+ }
+
+ if ( $opt_bench )
+ {
+ initialize_servers();
+ run_benchmarks(shift); # Shift what? Extra arguments?!
+ }
+ elsif ( $opt_stress )
+ {
+ initialize_servers();
+ run_stress_test()
+ }
+ else
+ {
+ # Figure out which tests we are going to run
+ if (!$opt_suites)
+ {
+ $opt_suites= $opt_suites_default;
+ }
+
+ my $tests= collect_test_cases($opt_suites);
+
+ my ($need_debug);
+ foreach my $test (@$tests)
+ {
+ next if $test->{skip};
+
+ if (!$opt_extern)
+ {
+ $need_debug||=$test->{need_debug};
+
+ # Count max number of slaves used by a test case
+ if ( $test->{slave_num} > $max_slave_num) {
+ $max_slave_num= $test->{slave_num};
+ mtr_error("Too many slaves") if $max_slave_num > 3;
+ }
+
+ # Count max number of masters used by a test case
+ if ( $test->{master_num} > $max_master_num) {
+ $max_master_num= $test->{master_num};
+ mtr_error("Too many masters") if $max_master_num > 2;
+ mtr_error("Too few masters") if $max_master_num < 1;
+ }
+ }
+ $use_innodb||= $test->{'innodb_test'};
+ }
+
+ if ( !$need_debug && !$opt_debug)
+ {
+ $opt_debug=0;
+ }
+
+ initialize_servers();
+
+ if ( $opt_report_features ) {
+ run_report_features();
+ }
+
+ run_tests($tests);
+ }
+
+ mtr_exit(0);
+}
+
+##############################################################################
+#
+# Default settings
+#
+##############################################################################
+
+#
+# When an option is no longer used by this program, it must be explicitly
+# ignored or else it will be passed through to mysqld. GetOptions will call
+# this subroutine once for each such option on the command line. See
+# Getopt::Long documentation.
+#
+
+sub warn_about_removed_option {
+ my ($option, $value, $hash_value) = @_;
+
+ warn "WARNING: This option is no longer used, and is ignored: --$option\n";
+}
+
+sub command_line_setup () {
+
+ # These are defaults for things that are set on the command line
+
+ my $opt_comment;
+
+ # Magic number -69.4 results in traditional test ports starting from 9306.
+ set_mtr_build_thread_ports(-69.4);
+
+ # If so requested, we try to avail ourselves of a unique build thread number.
+ if ( $ENV{'MTR_BUILD_THREAD'} ) {
+ if ( lc($ENV{'MTR_BUILD_THREAD'}) eq 'auto' ) {
+ print "Requesting build thread... ";
+ $ENV{'MTR_BUILD_THREAD'} = mtr_require_unique_id_and_wait("/tmp/mysql-test-ports", 200, 299);
+ print "got ".$ENV{'MTR_BUILD_THREAD'}."\n";
+ }
+ }
+
+ if ( $ENV{'MTR_BUILD_THREAD'} )
+ {
+ set_mtr_build_thread_ports($ENV{'MTR_BUILD_THREAD'});
+ }
+
+ # This is needed for test log evaluation in "gen-build-status-page"
+ # in all cases where the calling tool does not log the commands
+ # directly before it executes them, like "make test-force-pl" in RPM builds.
+ print "Logging: $0 ", join(" ", @ARGV), "\n";
+
+ # Read the command line
+ # Note: Keep list, and the order, in sync with usage at end of this file
+
+ # Options that are no longer used must still be processed, because all
+ # unprocessed options are passed directly to mysqld. The user will be
+ # warned that the option is being ignored.
+ #
+ # Put the complete option string here. For example, to remove the --suite
+ # option, remove it from GetOptions() below and put 'suite|suites=s' here.
+ my @removed_options = (
+ );
+
+ Getopt::Long::Configure("pass_through");
+ my %options=(
+ # Control what engine/variation to run
+ 'embedded-server' => \$opt_embedded_server,
+ 'ps-protocol' => \$opt_ps_protocol,
+ 'sp-protocol' => \$opt_sp_protocol,
+ 'view-protocol' => \$opt_view_protocol,
+ 'cursor-protocol' => \$opt_cursor_protocol,
+ 'ssl|with-openssl' => \$opt_ssl,
+ 'skip-ssl' => \$opt_skip_ssl,
+ 'compress' => \$opt_compress,
+ 'bench' => \$opt_bench,
+ 'small-bench' => \$opt_small_bench,
+ 'vs-config' => \$multiconfig,
+
+ # Control what test suites or cases to run
+ 'force' => \$opt_force,
+ 'skip-master-binlog' => \$opt_skip_master_binlog,
+ 'skip-slave-binlog' => \$opt_skip_slave_binlog,
+ 'do-test=s' => \$opt_do_test,
+ 'start-from=s' => \$opt_start_from,
+ 'suite|suites=s' => \$opt_suites,
+ 'skip-rpl' => \$opt_skip_rpl,
+ 'skip-test=s' => \$opt_skip_test,
+ 'big-test' => \$opt_big_test,
+ 'combination=s' => \@opt_combinations,
+ 'skip-combination' => \$opt_skip_combination,
+
+ # Specify ports
+ 'master_port=i' => \$opt_master_myport,
+ 'slave_port=i' => \$opt_slave_myport,
+ 'mtr-build-thread=i' => \$opt_mtr_build_thread,
+
+ # Test case authoring
+ 'record' => \$opt_record,
+ 'check-testcases' => \$opt_check_testcases,
+ 'mark-progress' => \$opt_mark_progress,
+
+ # Extra options used when starting mysqld
+ 'mysqld=s' => \@opt_extra_mysqld_opt,
+
+ # Extra options used when starting mysqld
+ 'mysqltest=s' => \@opt_extra_mysqltest_opt,
+
+ # Run test on running server
+ 'extern' => \$opt_extern,
+
+ # Debugging
+ 'gdb' => \$opt_gdb,
+ 'client-gdb' => \$opt_client_gdb,
+ 'manual-gdb' => \$opt_manual_gdb,
+ 'manual-debug' => \$opt_manual_debug,
+ 'ddd' => \$opt_ddd,
+ 'client-ddd' => \$opt_client_ddd,
+ 'manual-ddd' => \$opt_manual_ddd,
+ 'debugger=s' => \$opt_debugger,
+ 'client-debugger=s' => \$opt_client_debugger,
+ 'strace-client' => \$opt_strace_client,
+ 'master-binary=s' => \$exe_master_mysqld,
+ 'slave-binary=s' => \$exe_slave_mysqld,
+ 'max-save-core=i' => \$opt_max_save_core,
+
+ # Coverage, profiling etc
+ 'gcov' => \$opt_gcov,
+ 'gprof' => \$opt_gprof,
+ 'valgrind|valgrind-all' => \$opt_valgrind,
+ 'valgrind-mysqltest' => \$opt_valgrind_mysqltest,
+ 'valgrind-mysqld' => \$opt_valgrind_mysqld,
+ 'valgrind-options=s' => sub {
+ my ($opt, $value)= @_;
+ # Deprecated option unless it's what we know pushbuild uses
+ if ($value eq "--gen-suppressions=all --show-reachable=yes") {
+ push(@valgrind_args, $_) for (split(' ', $value));
+ return;
+ }
+ die("--valgrind-options=s is deprecated. Use ",
+ "--valgrind-option=s, to be specified several",
+ " times if necessary");
+ },
+ 'valgrind-option=s' => \@valgrind_args,
+ 'valgrind-path=s' => \$opt_valgrind_path,
+ 'callgrind' => \$opt_callgrind,
+
+ # Stress testing
+ 'stress' => \$opt_stress,
+ 'stress-suite=s' => \$opt_stress_suite,
+ 'stress-threads=i' => \$opt_stress_threads,
+ 'stress-test-file=s' => \$opt_stress_test_file,
+ 'stress-init-file=s' => \$opt_stress_init_file,
+ 'stress-mode=s' => \$opt_stress_mode,
+ 'stress-loop-count=i' => \$opt_stress_loop_count,
+ 'stress-test-count=i' => \$opt_stress_test_count,
+ 'stress-test-duration=i' => \$opt_stress_test_duration,
+
+ # Directories
+ 'tmpdir=s' => \$opt_tmpdir,
+ 'vardir=s' => \$opt_vardir,
+ 'benchdir=s' => \$glob_mysql_bench_dir,
+ 'mem' => \$opt_mem,
+ 'client-bindir=s' => \$path_client_bindir,
+ 'client-libdir=s' => \$path_client_libdir,
+
+ # Misc
+ 'report-features' => \$opt_report_features,
+ 'comment=s' => \$opt_comment,
+ 'debug' => \$opt_debug,
+ 'fast' => \$opt_fast,
+ 'reorder' => \$opt_reorder,
+ 'enable-disabled' => \$opt_enable_disabled,
+ 'script-debug' => \$opt_script_debug,
+ 'verbose' => \$opt_verbose,
+ 'sleep=i' => \$opt_sleep,
+ 'socket=s' => \$opt_socket,
+ 'start-dirty' => \$opt_start_dirty,
+ 'start-and-exit' => \$opt_start_and_exit,
+ 'timer!' => \$opt_timer,
+ 'user=s' => \$opt_user,
+ 'testcase-timeout=i' => \$opt_testcase_timeout,
+ 'suite-timeout=i' => \$opt_suite_timeout,
+ 'warnings|log-warnings' => \$opt_warnings,
+
+ # Options which are no longer used
+ (map { $_ => \&warn_about_removed_option } @removed_options),
+
+ 'help|h' => \$opt_usage,
+ 'list-options' => \$opt_list_options,
+ );
+
+ GetOptions(%options) or usage("Can't read options");
+
+ usage("") if $opt_usage;
+ list_options(\%options) if $opt_list_options;
+
+ $glob_scriptname= basename($0);
+
+ if ($opt_mtr_build_thread != 0)
+ {
+ set_mtr_build_thread_ports($opt_mtr_build_thread)
+ }
+ elsif ($ENV{'MTR_BUILD_THREAD'})
+ {
+ $opt_mtr_build_thread= $ENV{'MTR_BUILD_THREAD'};
+ }
+
+ # We require that we are in the "mysql-test" directory
+ # to run mysql-test-run
+ if (! -f $glob_scriptname)
+ {
+ mtr_error("Can't find the location for the mysql-test-run script\n" .
+ "Go to the mysql-test directory and execute the script " .
+ "as follows:\n./$glob_scriptname");
+ }
+
+ if ( -d "../sql" )
+ {
+ $source_dist= 1;
+ }
+
+ # Find the absolute path to the test directory
+ $glob_mysql_test_dir= cwd();
+ if ( $glob_cygwin_perl )
+ {
+ # Windows programs like 'mysqld' needs Windows paths
+ $glob_mysql_test_dir= `cygpath -m "$glob_mysql_test_dir"`;
+ chomp($glob_mysql_test_dir);
+ }
+ if (defined $ENV{MTR_BINDIR})
+ {
+ $default_vardir= "$ENV{MTR_BINDIR}/mysql-test/var";
+ }
+ else
+ {
+ $default_vardir= "$glob_mysql_test_dir/var";
+ }
+
+ # In most cases, the base directory we find everything relative to,
+ # is the parent directory of the "mysql-test" directory. For source
+ # distributions, TAR binary distributions and some other packages.
+ $glob_basedir= dirname($glob_mysql_test_dir);
+
+ $glob_bindir= $ENV{'MTR_BINDIR'} || $glob_basedir;
+ # In the RPM case, binaries and libraries are installed in the
+ # default system locations, instead of having our own private base
+ # directory. And we install "/usr/share/mysql-test". Moving up one
+ # more directory relative to "mysql-test" gives us a usable base
+ # directory for RPM installs.
+ if ( ! $source_dist and ! -d "$glob_basedir/bin" )
+ {
+ $glob_basedir= dirname($glob_basedir);
+ }
+
+ # Expect mysql-bench to be located adjacent to the source tree, by default
+ $glob_mysql_bench_dir= "$glob_basedir/../mysql-bench"
+ unless defined $glob_mysql_bench_dir;
+ $glob_mysql_bench_dir= undef
+ unless -d $glob_mysql_bench_dir;
+
+
+ $glob_timers= mtr_init_timers();
+
+ # --------------------------------------------------------------------------
+ # Embedded server flag
+ # --------------------------------------------------------------------------
+ if ( $opt_embedded_server )
+ {
+ $glob_use_embedded_server= 1;
+ # Add the location for libmysqld.dll to the path.
+ if ( $glob_win32 )
+ {
+ my $lib_mysqld=
+ mtr_path_exists(vs_config_dirs('libmysqld',''));
+ $lib_mysqld= $glob_cygwin_perl ? ":".`cygpath "$lib_mysqld"`
+ : ";".$lib_mysqld;
+ chomp($lib_mysqld);
+ $ENV{'PATH'}="$ENV{'PATH'}".$lib_mysqld;
+ }
+
+ push(@glob_test_mode, "embedded");
+ $opt_skip_rpl= 1; # We never run replication with embedded
+ $opt_skip_ssl= 1; # Turn off use of SSL
+
+ # Turn off use of bin log
+ push(@opt_extra_mysqld_opt, "--skip-log-bin");
+
+ if ( $opt_extern )
+ {
+ mtr_error("Can't use --extern with --embedded-server");
+ }
+ }
+
+ #
+ # Find the mysqld executable to be able to find the mysqld version
+ # number as early as possible
+ #
+
+ # Look for the client binaries directory
+ if ($path_client_bindir)
+ {
+ # --client-bindir=path set on command line, check that the path exists
+ $path_client_bindir= mtr_path_exists($path_client_bindir);
+ }
+ else
+ {
+ $path_client_bindir= mtr_path_exists("$glob_bindir/client_release",
+ "$glob_bindir/client_debug",
+ vs_config_dirs('client', ''),
+ "$glob_bindir/client",
+ "$glob_bindir/bin");
+ }
+
+ # Look for language files and charsetsdir, use same share
+ $path_share= mtr_path_exists("$glob_bindir/share/mysql",
+ "$glob_bindir/sql/share",
+ "$glob_bindir/share");
+
+ $path_language= mtr_path_exists("$path_share");
+ $path_charsetsdir = mtr_path_exists("$glob_basedir/share/mysql/charsets",
+ "$glob_basedir/sql/share/charsets",
+ "$glob_basedir/share/charsets");
+
+ if (!$opt_extern)
+ {
+ $exe_mysqld= mtr_exe_exists (vs_config_dirs('sql', 'mysqld'),
+ vs_config_dirs('sql', 'mysqld-debug'),
+ "$glob_bindir/sql/mysqld",
+ "$path_client_bindir/mysqld-max-nt",
+ "$path_client_bindir/mysqld-max",
+ "$path_client_bindir/mysqld-nt",
+ "$path_client_bindir/mysqld",
+ "$path_client_bindir/mysqld-debug",
+ "$path_client_bindir/mysqld-max",
+ "$glob_bindir/libexec/mysqld",
+ "$glob_bindir/bin/mariadbd",
+ "$glob_bindir/sbin/mariadbd");
+
+ # Use the mysqld found above to find out what features are available
+ collect_mysqld_features();
+ }
+ else
+ {
+ $mysqld_variables{'port'}= 3306;
+ $mysqld_variables{'master-port'}= 3306;
+ }
+
+ if ( $opt_comment )
+ {
+ print "\n";
+ print '#' x 78, "\n";
+ print "# $opt_comment\n";
+ print '#' x 78, "\n\n";
+ }
+
+ foreach my $arg ( @ARGV )
+ {
+ if ( $arg =~ /^--skip-/ )
+ {
+ push(@opt_extra_mysqld_opt, $arg);
+ }
+ elsif ( $arg =~ /^--$/ )
+ {
+ # It is an effect of setting 'pass_through' in option processing
+ # that the lone '--' separating options from arguments survives,
+ # simply ignore it.
+ }
+ elsif ( $arg =~ /^-/ )
+ {
+ usage("Invalid option \"$arg\"");
+ }
+ else
+ {
+ push(@opt_cases, $arg);
+ }
+ }
+
+ # --------------------------------------------------------------------------
+ # Find out type of logging that are being used
+ # --------------------------------------------------------------------------
+ if (!$opt_extern && $mysql_version_id >= 50100 )
+ {
+ foreach my $arg ( @opt_extra_mysqld_opt )
+ {
+ if ( $arg =~ /binlog[-_]format=(\S+)/ )
+ {
+ $used_binlog_format= $1;
+ }
+ }
+ if (defined $used_binlog_format)
+ {
+ mtr_report("Using binlog format '$used_binlog_format'");
+ }
+ else
+ {
+ mtr_report("Using dynamic switching of binlog format");
+ }
+ }
+
+
+ # --------------------------------------------------------------------------
+ # Find out default storage engine being used(if any)
+ # --------------------------------------------------------------------------
+ foreach my $arg ( @opt_extra_mysqld_opt )
+ {
+ if ( $arg =~ /default-storage-engine=(\S+)/ )
+ {
+ $used_default_engine= $1;
+ }
+ }
+ mtr_report("Using default engine '$used_default_engine'")
+ if defined $used_default_engine;
+
+ if ($glob_win32 and defined $opt_mem) {
+ mtr_report("--mem not supported on Windows, ignored");
+ $opt_mem= undef;
+ }
+
+ # --------------------------------------------------------------------------
+ # Check if we should speed up tests by trying to run on tmpfs
+ # --------------------------------------------------------------------------
+ if ( defined $opt_mem )
+ {
+ mtr_error("Can't use --mem and --vardir at the same time ")
+ if $opt_vardir;
+ mtr_error("Can't use --mem and --tmpdir at the same time ")
+ if $opt_tmpdir;
+
+ # Search through list of locations that are known
+ # to be "fast disks" to list to find a suitable location
+ # Use --mem=<dir> as first location to look.
+ my @tmpfs_locations= ($opt_mem, "/dev/shm", "/tmp");
+
+ foreach my $fs (@tmpfs_locations)
+ {
+ if ( -d $fs )
+ {
+ mtr_report("Using tmpfs in $fs");
+ $opt_mem= "$fs/var";
+ $opt_mem .= $opt_mtr_build_thread if $opt_mtr_build_thread;
+ last;
+ }
+ }
+ }
+
+ # --------------------------------------------------------------------------
+ # Set the "var/" directory, as it is the base for everything else
+ # --------------------------------------------------------------------------
+ if ( ! $opt_vardir )
+ {
+ $opt_vardir= $default_vardir;
+ }
+ elsif ( $mysql_version_id < 50000 and
+ $opt_vardir ne $default_vardir)
+ {
+ # Version 4.1 and --vardir was specified
+ # Only supported as a symlink from var/
+ # by setting up $opt_mem that symlink will be created
+ if ( ! $glob_win32 )
+ {
+ # Only platforms that have native symlinks can use the vardir trick
+ $opt_mem= $opt_vardir;
+ mtr_report("Using 4.1 vardir trick");
+ }
+
+ $opt_vardir= $default_vardir;
+ }
+
+ $path_vardir_trace= $opt_vardir;
+ # Chop off any "c:", DBUG likes a unix path ex: c:/src/... => /src/...
+ $path_vardir_trace=~ s/^\w://;
+
+ # We make the path absolute, as the server will do a chdir() before usage
+ unless ( $opt_vardir =~ m,^/, or
+ ($glob_win32 and $opt_vardir =~ m,^[a-z]:/,i) )
+ {
+ # Make absolute path, relative test dir
+ $opt_vardir= "$glob_mysql_test_dir/$opt_vardir";
+ }
+
+ # --------------------------------------------------------------------------
+ # Set tmpdir
+ # --------------------------------------------------------------------------
+ $opt_tmpdir= "$opt_vardir/tmp" unless $opt_tmpdir;
+ $opt_tmpdir =~ s,/+$,,; # Remove ending slash if any
+
+ # --------------------------------------------------------------------------
+ # Record flag
+ # --------------------------------------------------------------------------
+ if ( $opt_record and ! @opt_cases )
+ {
+ mtr_error("Will not run in record mode without a specific test case");
+ }
+
+ if ( $opt_record )
+ {
+ $opt_skip_combination = 1;
+ }
+
+ # --------------------------------------------------------------------------
+ # ps protcol flag
+ # --------------------------------------------------------------------------
+ if ( $opt_ps_protocol )
+ {
+ push(@glob_test_mode, "ps-protocol");
+ }
+
+ # --------------------------------------------------------------------------
+ # Bench flags
+ # --------------------------------------------------------------------------
+ if ( $opt_small_bench )
+ {
+ $opt_bench= 1;
+ }
+
+ # --------------------------------------------------------------------------
+ # Big test flags
+ # --------------------------------------------------------------------------
+ if ( $opt_big_test )
+ {
+ $ENV{'BIG_TEST'}= 1;
+ }
+
+ # --------------------------------------------------------------------------
+ # Gcov flag
+ # --------------------------------------------------------------------------
+ if ( $opt_gcov and ! $source_dist )
+ {
+ mtr_error("Coverage test needs the source - please use source dist");
+ }
+
+ # --------------------------------------------------------------------------
+ # Check debug related options
+ # --------------------------------------------------------------------------
+ if ( $opt_gdb || $opt_client_gdb || $opt_ddd || $opt_client_ddd ||
+ $opt_manual_gdb || $opt_manual_ddd || $opt_manual_debug ||
+ $opt_debugger || $opt_client_debugger )
+ {
+ # Indicate that we are using debugger
+ $glob_debugger= 1;
+ if ( $opt_extern )
+ {
+ mtr_error("Can't use --extern when using debugger");
+ }
+ }
+
+ # --------------------------------------------------------------------------
+ # Check if special exe was selected for master or slave
+ # --------------------------------------------------------------------------
+ $exe_master_mysqld= $exe_master_mysqld || $exe_mysqld;
+ $exe_slave_mysqld= $exe_slave_mysqld || $exe_mysqld;
+
+ # --------------------------------------------------------------------------
+ # Check valgrind arguments
+ # --------------------------------------------------------------------------
+ if ( $opt_valgrind or $opt_valgrind_path or @valgrind_args)
+ {
+ mtr_report("Turning on valgrind for all executables");
+ $opt_valgrind= 1;
+ $opt_valgrind_mysqld= 1;
+ $opt_valgrind_mysqltest= 1;
+ }
+ elsif ( $opt_valgrind_mysqld )
+ {
+ mtr_report("Turning on valgrind for mysqld(s) only");
+ $opt_valgrind= 1;
+ }
+ elsif ( $opt_valgrind_mysqltest )
+ {
+ mtr_report("Turning on valgrind for mysqltest and mysql_client_test only");
+ $opt_valgrind= 1;
+ }
+
+ if ( $opt_callgrind )
+ {
+ mtr_report("Turning on valgrind with callgrind for mysqld(s)");
+ $opt_valgrind= 1;
+ $opt_valgrind_mysqld= 1;
+
+ # Set special valgrind options unless options passed on command line
+ push(@valgrind_args, "--trace-children=yes")
+ unless @valgrind_args;
+ }
+
+ if ( $opt_valgrind )
+ {
+ # Set valgrind_options to default unless already defined
+ push(@valgrind_args, @default_valgrind_args)
+ unless @valgrind_args;
+
+ mtr_report("Running valgrind with options \"",
+ join(" ", @valgrind_args), "\"");
+ }
+
+ if ( ! $opt_testcase_timeout )
+ {
+ $opt_testcase_timeout=
+ $ENV{MTR_TESTCASE_TIMEOUT} || $default_testcase_timeout;
+ $opt_testcase_timeout*= 10 if $opt_valgrind;
+ $opt_testcase_timeout*= 10 if ($opt_debug and $glob_win32);
+ }
+
+ if ( ! $opt_suite_timeout )
+ {
+ $opt_suite_timeout=
+ $ENV{MTR_SUITE_TIMEOUT} || $default_suite_timeout;
+ $opt_suite_timeout*= 6 if $opt_valgrind;
+ $opt_suite_timeout*= 6 if ($opt_debug and $glob_win32);
+ }
+
+ if ( ! $opt_user )
+ {
+ if ( $opt_extern )
+ {
+ $opt_user= "test";
+ }
+ else
+ {
+ $opt_user= "root"; # We want to do FLUSH xxx commands
+ }
+ }
+
+ # On QNX, /tmp/dir/master.sock and /tmp/dir//master.sock seem to be
+ # considered different, so avoid the extra slash (/) in the socket
+ # paths.
+ my $sockdir = $opt_tmpdir;
+ $sockdir =~ s|/+$||;
+
+ # On some operating systems, there is a limit to the length of a
+ # UNIX domain socket's path far below PATH_MAX, so try to avoid long
+ # socket path names.
+ $sockdir = tempdir(CLEANUP => 0) if ( length($sockdir) >= 70 );
+
+ $master->[0]=
+ {
+ pid => 0,
+ type => "master",
+ idx => 0,
+ path_myddir => "$opt_vardir/master-data",
+ path_myerr => "$opt_vardir/log/master.err",
+ path_pid => "$opt_vardir/run/master.pid",
+ path_sock => "$sockdir/master.sock",
+ port => $opt_master_myport,
+ start_timeout => 400, # enough time create innodb tables
+ start_opts => [],
+ };
+
+ $master->[1]=
+ {
+ pid => 0,
+ type => "master",
+ idx => 1,
+ path_myddir => "$opt_vardir/master1-data",
+ path_myerr => "$opt_vardir/log/master1.err",
+ path_pid => "$opt_vardir/run/master1.pid",
+ path_sock => "$sockdir/master1.sock",
+ port => $opt_master_myport + 1,
+ start_timeout => 400, # enough time create innodb tables
+ start_opts => [],
+ };
+
+ $slave->[0]=
+ {
+ pid => 0,
+ type => "slave",
+ idx => 0,
+ path_myddir => "$opt_vardir/slave-data",
+ path_myerr => "$opt_vardir/log/slave.err",
+ path_pid => "$opt_vardir/run/slave.pid",
+ path_sock => "$sockdir/slave.sock",
+ port => $opt_slave_myport,
+ start_timeout => 400,
+
+ start_opts => [],
+ };
+
+ $slave->[1]=
+ {
+ pid => 0,
+ type => "slave",
+ idx => 1,
+ path_myddir => "$opt_vardir/slave1-data",
+ path_myerr => "$opt_vardir/log/slave1.err",
+ path_pid => "$opt_vardir/run/slave1.pid",
+ path_sock => "$sockdir/slave1.sock",
+ port => $opt_slave_myport + 1,
+ start_timeout => 300,
+ start_opts => [],
+ };
+
+ $slave->[2]=
+ {
+ pid => 0,
+ type => "slave",
+ idx => 2,
+ path_myddir => "$opt_vardir/slave2-data",
+ path_myerr => "$opt_vardir/log/slave2.err",
+ path_pid => "$opt_vardir/run/slave2.pid",
+ path_sock => "$sockdir/slave2.sock",
+ port => $opt_slave_myport + 2,
+ start_timeout => 300,
+ start_opts => [],
+ };
+
+ # --------------------------------------------------------------------------
+ # extern
+ # --------------------------------------------------------------------------
+ if ( $opt_extern )
+ {
+ # Turn off features not supported when running with extern server
+ $opt_skip_rpl= 1;
+
+ # Setup master->[0] with the settings for the extern server
+ $master->[0]->{'path_sock'}= $opt_socket ? $opt_socket : "/tmp/mysql.sock";
+ mtr_report("Using extern server at '$master->[0]->{path_sock}'");
+ }
+ else
+ {
+ mtr_error("--socket can only be used in combination with --extern")
+ if $opt_socket;
+ }
+
+
+
+ $path_timefile= "$opt_vardir/log/mysqltest-time";
+ $path_mysqltest_log= "$opt_vardir/log/mysqltest.log";
+ $path_current_test_log= "$opt_vardir/log/current_test";
+
+ $path_snapshot= "$opt_tmpdir/snapshot_$opt_master_myport/";
+}
+
+#
+# To make it easier for different devs to work on the same host,
+# an environment variable can be used to control all ports. A small
+# number is to be used, 0 - 16 or similar.
+#
+# Note the MASTER_MYPORT has to be set the same in all 4.x and 5.x
+# versions of this script, else a 4.0 test run might conflict with a
+# 5.1 test run, even if different MTR_BUILD_THREAD is used. This means
+# all port numbers might not be used in this version of the script.
+#
+# Also note the limitation of ports we are allowed to hand out. This
+# differs between operating systems and configuration, see
+# http://www.ncftp.com/ncftpd/doc/misc/ephemeral_ports.html
+# But a fairly safe range seems to be 5001 - 32767
+#
+
+sub set_mtr_build_thread_ports($) {
+ my $mtr_build_thread= shift;
+
+ if ( lc($mtr_build_thread) eq 'auto' ) {
+ print "Requesting build thread... ";
+ $ENV{'MTR_BUILD_THREAD'} = $mtr_build_thread = mtr_require_unique_id_and_wait("/tmp/mysql-test-ports", 200, 299);
+ print "got ".$mtr_build_thread."\n";
+ }
+
+ # Up to two masters, up to three slaves
+ # A magic value in command_line_setup depends on these equations.
+ $opt_master_myport= $mtr_build_thread * 10 + 10000; # and 1
+ $opt_slave_myport= $opt_master_myport + 2; # and 3 4
+
+ if ( $opt_master_myport < 5001 or $opt_master_myport + 10 >= 32767 )
+ {
+ mtr_error("MTR_BUILD_THREAD number results in a port",
+ "outside 5001 - 32767",
+ "($opt_master_myport - $opt_master_myport + 10)");
+ }
+}
+
+
+sub datadir_list_setup () {
+
+ # Make a list of all data_dirs
+ for (my $idx= 0; $idx < $max_master_num; $idx++)
+ {
+ push(@data_dir_lst, $master->[$idx]->{'path_myddir'});
+ }
+
+ for (my $idx= 0; $idx < $max_slave_num; $idx++)
+ {
+ push(@data_dir_lst, $slave->[$idx]->{'path_myddir'});
+ }
+}
+
+
+##############################################################################
+#
+# Set paths to various executable programs
+#
+##############################################################################
+
+
+sub collect_mysqld_features () {
+ my $found_variable_list_start= 0;
+ my $tmpdir;
+ if ( $opt_tmpdir ) {
+ # Use the requested tmpdir
+ mkpath($opt_tmpdir) if (! -d $opt_tmpdir);
+ $tmpdir= $opt_tmpdir;
+ }
+ else {
+ $tmpdir= tempdir(CLEANUP => 0); # Directory removed by this function
+ }
+
+ #
+ # Execute "mysqld --help --verbose" to get a list
+ # list of all features and settings
+ #
+ # --no-defaults and --skip-grant-tables are to avoid loading
+ # system-wide configs and plugins
+ #
+ # --datadir must exist, mysqld will chdir into it
+ #
+ my $list= `$exe_mysqld --no-defaults --datadir=$tmpdir --lc-messages-dir=$path_language --skip-grant-tables --verbose --help`;
+
+ foreach my $line (split('\n', $list))
+ {
+ # First look for version
+ if ( !$mysql_version_id )
+ {
+ # Look for version
+ my $exe_name= basename($exe_mysqld);
+ mtr_verbose("exe_name: $exe_name");
+ if ( $line =~ /^\S*$exe_name\s\sVer\s([0-9]*)\.([0-9]*)\.([0-9]*)/ )
+ {
+ #print "Major: $1 Minor: $2 Build: $3\n";
+ $mysql_version_id= $1*10000 + $2*100 + $3;
+ #print "mysql_version_id: $mysql_version_id\n";
+ mtr_report("MySQL Version $1.$2.$3");
+ }
+ }
+ else
+ {
+ if (!$found_variable_list_start)
+ {
+ # Look for start of variables list
+ if ( $line =~ /[\-]+\s[\-]+/ )
+ {
+ $found_variable_list_start= 1;
+ }
+ }
+ else
+ {
+ # Put variables into hash
+ if ( $line =~ /^([\S]+)[ \t]+(.*?)\r?$/ )
+ {
+ # print "$1=\"$2\"\n";
+ $mysqld_variables{$1}= $2;
+ }
+ else
+ {
+ # The variable list is ended with a blank line
+ if ( $line =~ /^[\s]*$/ )
+ {
+ last;
+ }
+ else
+ {
+ # Send out a warning, we should fix the variables that has no
+ # space between variable name and it's value
+ # or should it be fixed width column parsing? It does not
+ # look like that in function my_print_variables in my_getopt.c
+ mtr_warning("Could not parse variable list line : $line");
+ }
+ }
+ }
+ }
+ }
+ rmtree($tmpdir) if (!$opt_tmpdir);
+ mtr_error("Could not find version of MySQL") unless $mysql_version_id;
+ mtr_error("Could not find variabes list") unless $found_variable_list_start;
+
+}
+
+
+sub run_query($$) {
+ my ($mysqld, $query)= @_;
+
+ my $args;
+ mtr_init_args(\$args);
+
+ mtr_add_arg($args, "--no-defaults");
+ mtr_add_arg($args, "--user=%s", $opt_user);
+ mtr_add_arg($args, "--port=%d", $mysqld->{'port'});
+ mtr_add_arg($args, "--socket=%s", $mysqld->{'path_sock'});
+ mtr_add_arg($args, "--silent"); # Tab separated output
+ mtr_add_arg($args, "-e '%s'", $query);
+
+ my $cmd= "$exe_mysql " . join(' ', @$args);
+ mtr_verbose("cmd: $cmd");
+ return `$cmd`;
+}
+
+
+sub collect_mysqld_features_from_running_server ()
+{
+ my $list= run_query($master->[0], "use mysql; SHOW VARIABLES");
+
+ foreach my $line (split('\n', $list))
+ {
+ # Put variables into hash
+ if ( $line =~ /^([\S]+)[ \t]+(.*?)\r?$/ )
+ {
+ print "$1=\"$2\"\n";
+ $mysqld_variables{$1}= $2;
+ }
+ }
+}
+
+sub executable_setup () {
+
+ #
+ # Check if libtool is available in this distribution/clone
+ # we need it when valgrinding or debugging non installed binary
+ # Otherwise valgrind will valgrind the libtool wrapper or bash
+ # and gdb will not find the real executable to debug
+ #
+ if ( -x "../libtool")
+ {
+ $exe_libtool= "../libtool";
+ if ($opt_valgrind or $glob_debugger)
+ {
+ mtr_report("Using \"$exe_libtool\" when running valgrind or debugger");
+ }
+ }
+
+ # Look for my_print_defaults
+ $exe_my_print_defaults=
+ mtr_exe_exists(vs_config_dirs('extra', 'my_print_defaults'),
+ "$path_client_bindir/my_print_defaults",
+ "$glob_bindir/extra/my_print_defaults");
+
+ # Look for perror
+ $exe_perror= mtr_exe_exists(vs_config_dirs('extra', 'perror'),
+ "$glob_bindir/extra/perror",
+ "$path_client_bindir/perror");
+
+ # Look for the client binaries
+ $exe_mysqlcheck= mtr_exe_exists("$path_client_bindir/mysqlcheck");
+ $exe_mysqldump= mtr_exe_exists("$path_client_bindir/mysqldump");
+ $exe_mysqlimport= mtr_exe_exists("$path_client_bindir/mysqlimport");
+ $exe_mysqlshow= mtr_exe_exists("$path_client_bindir/mysqlshow");
+ $exe_mysqlbinlog= mtr_exe_exists("$path_client_bindir/mysqlbinlog");
+ $exe_mysqladmin= mtr_exe_exists("$path_client_bindir/mysqladmin");
+ $exe_mysql= mtr_exe_exists("$path_client_bindir/mysql");
+
+ if (!$opt_extern)
+ {
+ # Look for SQL scripts directory
+ if ( mtr_file_exists("$path_share/mysql_system_tables.sql") ne "")
+ {
+ # The SQL scripts are in path_share
+ $path_sql_dir= $path_share;
+ }
+ else
+ {
+ $path_sql_dir= mtr_path_exists("$glob_basedir/share",
+ "$glob_basedir/scripts");
+ }
+
+ if ( $mysql_version_id >= 50100 )
+ {
+ $exe_mysqlslap= mtr_exe_exists("$path_client_bindir/mysqlslap");
+ }
+ if ( $mysql_version_id >= 50000 and !$glob_use_embedded_server )
+ {
+ $exe_mysql_upgrade= mtr_exe_exists("$path_client_bindir/mysql_upgrade")
+ }
+ else
+ {
+ $exe_mysql_upgrade= "";
+ }
+
+ # Look for mysql_fix_privilege_tables.sql script
+ $file_mysql_fix_privilege_tables=
+ mtr_file_exists("$glob_basedir/scripts/mysql_fix_privilege_tables.sql",
+ "$glob_basedir/share/mysql_fix_privilege_tables.sql",
+ "$glob_basedir/share/mysql/mysql_fix_privilege_tables.sql");
+
+ # Look for the udf_example library
+ $lib_udf_example=
+ mtr_file_exists(vs_config_dirs('sql', 'udf_example.dll'),
+ "$glob_bindir/sql/.libs/udf_example.so",);
+
+ # Look for the ha_example library
+ $lib_example_plugin=
+ mtr_file_exists(vs_config_dirs('storage/example', 'ha_example.dll'),
+ "$glob_bindir/storage/example/.libs/ha_example.so",);
+
+ }
+
+ # Look for mysqltest executable
+ if ( $glob_use_embedded_server )
+ {
+ $exe_mysqltest=
+ mtr_exe_exists(vs_config_dirs('libmysqld/examples','mysqltest_embedded'),
+ "$glob_bindir/libmysqld/examples/mysqltest_embedded",
+ "$path_client_bindir/mysqltest_embedded");
+ }
+ else
+ {
+ $exe_mysqltest= mtr_exe_exists("$path_client_bindir/mysqltest");
+ }
+
+ # Look for mysql_client_test executable which may _not_ exist in
+ # some versions, test using it should be skipped
+ if ( $glob_use_embedded_server )
+ {
+ $exe_mysql_client_test=
+ mtr_exe_maybe_exists(
+ vs_config_dirs('libmysqld/examples', 'mysql_client_test_embedded'),
+ "$glob_bindir/libmysqld/examples/mysql_client_test_embedded");
+ }
+ else
+ {
+ $exe_mysql_client_test=
+ mtr_exe_maybe_exists(vs_config_dirs('tests', 'mysql_client_test'),
+ "$glob_bindir/tests/mysql_client_test",
+ "$glob_bindir/bin/mysql_client_test");
+ }
+
+ # Look for bug25714 executable which may _not_ exist in
+ # some versions, test using it should be skipped
+ $exe_bug25714=
+ mtr_exe_maybe_exists(vs_config_dirs('tests', 'bug25714'),
+ "$glob_bindir/tests/bug25714");
+}
+
+
+sub generate_cmdline_mysqldump ($) {
+ my($mysqld) = @_;
+ return
+ mtr_native_path($exe_mysqldump) .
+ " --no-defaults -uroot --debug-check " .
+ "--port=$mysqld->{'port'} " .
+ "--socket=$mysqld->{'path_sock'} --password=";
+}
+
+
+##############################################################################
+#
+# Set environment to be used by childs of this process for
+# things that are constant duting the whole lifetime of mysql-test-run.pl
+#
+##############################################################################
+
+sub mysql_client_test_arguments()
+{
+ my $exe= $exe_mysql_client_test;
+
+ my $args;
+ mtr_init_args(\$args);
+ if ( $opt_valgrind_mysqltest )
+ {
+ valgrind_arguments($args, \$exe);
+ }
+
+ mtr_add_arg($args, "--no-defaults");
+ mtr_add_arg($args, "--testcase");
+ mtr_add_arg($args, "--user=root");
+ mtr_add_arg($args, "--port=$master->[0]->{'port'}");
+ mtr_add_arg($args, "--socket=$master->[0]->{'path_sock'}");
+
+ if ( $opt_extern || $mysql_version_id >= 50000 )
+ {
+ mtr_add_arg($args, "--vardir=$opt_vardir")
+ }
+
+ if ( $opt_debug )
+ {
+ mtr_add_arg($args,
+ "--debug=d:t:A,$path_vardir_trace/log/mysql_client_test.trace");
+ }
+
+ if ( $glob_use_embedded_server )
+ {
+ mtr_add_arg($args,
+ " -A --lc-messages-dir=$path_language");
+ mtr_add_arg($args,
+ " -A --datadir=$slave->[0]->{'path_myddir'}");
+ mtr_add_arg($args,
+ " -A --character-sets-dir=$path_charsetsdir");
+ }
+
+ return join(" ", $exe, @$args);
+}
+
+sub mysql_upgrade_arguments()
+{
+ my $exe= $exe_mysql_upgrade;
+
+ my $args;
+ mtr_init_args(\$args);
+# if ( $opt_valgrind_mysql_ugrade )
+# {
+# valgrind_arguments($args, \$exe);
+# }
+
+ mtr_add_arg($args, "--no-defaults");
+ mtr_add_arg($args, "--user=root");
+ mtr_add_arg($args, "--port=$master->[0]->{'port'}");
+ mtr_add_arg($args, "--socket=$master->[0]->{'path_sock'}");
+ mtr_add_arg($args, "--datadir=$master->[0]->{'path_myddir'}");
+ mtr_add_arg($args, "--basedir=$glob_basedir");
+ mtr_add_arg($args, "--tmpdir=$opt_tmpdir");
+
+ if ( $opt_debug )
+ {
+ mtr_add_arg($args,
+ "--debug=d:t:A,$path_vardir_trace/log/mysql_upgrade.trace");
+ }
+
+ return join(" ", $exe, @$args);
+}
+
+# Note that some env is setup in spawn/run, in "mtr_process.pl"
+
+sub environment_setup () {
+
+ umask(022);
+
+ my @ld_library_paths;
+
+ if ($path_client_libdir)
+ {
+ # Use the --client-libdir passed on commandline
+ push(@ld_library_paths, "$path_client_libdir");
+ }
+ else
+ {
+ # Setup LD_LIBRARY_PATH so the libraries from this distro/clone
+ # are used in favor of the system installed ones
+ if ( $source_dist )
+ {
+ push(@ld_library_paths, "$glob_bindir/libmysql/.libs/",
+ "$glob_bindir/libmysql_r/.libs/",
+ "$glob_bindir/zlib.libs/");
+ }
+ else
+ {
+ push(@ld_library_paths, "$glob_bindir/lib");
+ }
+ }
+
+ # --------------------------------------------------------------------------
+ # Valgrind need to be run with debug libraries otherwise it's almost
+ # impossible to add correct supressions, that means if "/usr/lib/debug"
+ # is available, it should be added to
+ # LD_LIBRARY_PATH
+ #
+ # But pthread is broken in libc6-dbg on Debian <= 3.1 (see Debian
+ # bug 399035, http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=399035),
+ # so don't change LD_LIBRARY_PATH on that platform.
+ # --------------------------------------------------------------------------
+ my $debug_libraries_path= "/usr/lib/debug";
+ my $deb_version;
+ if ( $opt_valgrind and -d $debug_libraries_path and
+ (! -e '/etc/debian_version' or
+ ($deb_version= mtr_grab_file('/etc/debian_version')) !~ /^[0-9]+\.[0-9]$/ or
+ $deb_version > 3.1 ) )
+ {
+ push(@ld_library_paths, $debug_libraries_path);
+ }
+
+ $ENV{'LD_LIBRARY_PATH'}= join(":", @ld_library_paths,
+ $ENV{'LD_LIBRARY_PATH'} ?
+ split(':', $ENV{'LD_LIBRARY_PATH'}) : ());
+ mtr_debug("LD_LIBRARY_PATH: $ENV{'LD_LIBRARY_PATH'}");
+
+ $ENV{'DYLD_LIBRARY_PATH'}= join(":", @ld_library_paths,
+ $ENV{'DYLD_LIBRARY_PATH'} ?
+ split(':', $ENV{'DYLD_LIBRARY_PATH'}) : ());
+ mtr_debug("DYLD_LIBRARY_PATH: $ENV{'DYLD_LIBRARY_PATH'}");
+
+ # The environment variable used for shared libs on AIX
+ $ENV{'SHLIB_PATH'}= join(":", @ld_library_paths,
+ $ENV{'SHLIB_PATH'} ?
+ split(':', $ENV{'SHLIB_PATH'}) : ());
+ mtr_debug("SHLIB_PATH: $ENV{'SHLIB_PATH'}");
+
+ # The environment variable used for shared libs on hp-ux
+ $ENV{'LIBPATH'}= join(":", @ld_library_paths,
+ $ENV{'LIBPATH'} ?
+ split(':', $ENV{'LIBPATH'}) : ());
+ mtr_debug("LIBPATH: $ENV{'LIBPATH'}");
+
+ # --------------------------------------------------------------------------
+ # Also command lines in .opt files may contain env vars
+ # --------------------------------------------------------------------------
+
+ $ENV{'CHARSETSDIR'}= $path_charsetsdir;
+ $ENV{'UMASK'}= "0660"; # The octal *string*
+ $ENV{'UMASK_DIR'}= "0770"; # The octal *string*
+
+ #
+ # MySQL tests can produce output in various character sets
+ # (especially, ctype_xxx.test). To avoid confusing Perl
+ # with output which is incompatible with the current locale
+ # settings, we reset the current values of LC_ALL and LC_CTYPE to "C".
+ # For details, please see
+ # Bug#27636 tests fails if LC_* variables set to *_*.UTF-8
+ #
+ $ENV{'LC_ALL'}= "C";
+ $ENV{'LC_CTYPE'}= "C";
+
+ $ENV{'LC_COLLATE'}= "C";
+ $ENV{'USE_RUNNING_SERVER'}= $opt_extern;
+ $ENV{'MYSQL_TEST_DIR'}= $glob_mysql_test_dir;
+ $ENV{'MYSQLTEST_VARDIR'}= $opt_vardir;
+ $ENV{'MYSQL_TMP_DIR'}= $opt_tmpdir;
+ $ENV{'MASTER_MYSOCK'}= $master->[0]->{'path_sock'};
+ $ENV{'MASTER_MYSOCK1'}= $master->[1]->{'path_sock'};
+ $ENV{'MASTER_MYPORT'}= $master->[0]->{'port'};
+ $ENV{'MASTER_MYPORT1'}= $master->[1]->{'port'};
+ $ENV{'SLAVE_MYSOCK'}= $slave->[0]->{'path_sock'};
+ $ENV{'SLAVE_MYPORT'}= $slave->[0]->{'port'};
+ $ENV{'SLAVE_MYPORT1'}= $slave->[1]->{'port'};
+ $ENV{'SLAVE_MYPORT2'}= $slave->[2]->{'port'};
+ $ENV{'MYSQL_TCP_PORT'}= $mysqld_variables{'port'};
+ $ENV{'DEFAULT_MASTER_PORT'}= $mysqld_variables{'master-port'};
+
+ $ENV{MTR_BUILD_THREAD}= $opt_mtr_build_thread;
+
+ $ENV{'EXE_MYSQL'}= $exe_mysql;
+
+ # ----------------------------------------------------
+ # Setup env so childs can execute mysqlcheck
+ # ----------------------------------------------------
+ my $cmdline_mysqlcheck=
+ mtr_native_path($exe_mysqlcheck) .
+ " --no-defaults --debug-check -uroot " .
+ "--port=$master->[0]->{'port'} " .
+ "--socket=$master->[0]->{'path_sock'} --password=";
+
+ if ( $opt_debug )
+ {
+ $cmdline_mysqlcheck .=
+ " --debug=d:t:A,$path_vardir_trace/log/mysqlcheck.trace";
+ }
+ $ENV{'MYSQL_CHECK'}= $cmdline_mysqlcheck;
+
+ # ----------------------------------------------------
+ # Setup env to childs can execute myqldump
+ # ----------------------------------------------------
+ my $cmdline_mysqldump= generate_cmdline_mysqldump($master->[0]);
+ my $cmdline_mysqldumpslave= generate_cmdline_mysqldump($slave->[0]);
+
+ if ( $opt_debug )
+ {
+ $cmdline_mysqldump .=
+ " --debug=d:t:A,$path_vardir_trace/log/mysqldump-master.trace";
+ $cmdline_mysqldumpslave .=
+ " --debug=d:t:A,$path_vardir_trace/log/mysqldump-slave.trace";
+ }
+ $ENV{'MYSQL_DUMP'}= $cmdline_mysqldump;
+ $ENV{'MYSQL_DUMP_SLAVE'}= $cmdline_mysqldumpslave;
+
+
+ # ----------------------------------------------------
+ # Setup env so childs can execute mysqlslap
+ # ----------------------------------------------------
+ if ( $exe_mysqlslap )
+ {
+ my $cmdline_mysqlslap=
+ mtr_native_path($exe_mysqlslap) .
+ " -uroot " .
+ "--port=$master->[0]->{'port'} " .
+ "--socket=$master->[0]->{'path_sock'} --password= ";
+
+ if ( $opt_debug )
+ {
+ $cmdline_mysqlslap .=
+ " --debug=d:t:A,$path_vardir_trace/log/mysqlslap.trace";
+ }
+ $ENV{'MYSQL_SLAP'}= $cmdline_mysqlslap;
+ }
+
+ # ----------------------------------------------------
+ # Setup env so childs can execute mysqlimport
+ # ----------------------------------------------------
+ my $cmdline_mysqlimport=
+ mtr_native_path($exe_mysqlimport) .
+ " -uroot --debug-check " .
+ "--port=$master->[0]->{'port'} " .
+ "--socket=$master->[0]->{'path_sock'} --password=";
+
+ if ( $opt_debug )
+ {
+ $cmdline_mysqlimport .=
+ " --debug=d:t:A,$path_vardir_trace/log/mysqlimport.trace";
+ }
+ $ENV{'MYSQL_IMPORT'}= $cmdline_mysqlimport;
+
+
+ # ----------------------------------------------------
+ # Setup env so childs can execute mysqlshow
+ # ----------------------------------------------------
+ my $cmdline_mysqlshow=
+ mtr_native_path($exe_mysqlshow) .
+ " -uroot --debug-check " .
+ "--port=$master->[0]->{'port'} " .
+ "--socket=$master->[0]->{'path_sock'} --password=";
+
+ if ( $opt_debug )
+ {
+ $cmdline_mysqlshow .=
+ " --debug=d:t:A,$path_vardir_trace/log/mysqlshow.trace";
+ }
+ $ENV{'MYSQL_SHOW'}= $cmdline_mysqlshow;
+
+ # ----------------------------------------------------
+ # Setup env so childs can execute mysqlbinlog
+ # ----------------------------------------------------
+ my $cmdline_mysqlbinlog=
+ mtr_native_path($exe_mysqlbinlog) .
+ " --no-defaults --disable-force-if-open --debug-check";
+ if ( !$opt_extern && $mysql_version_id >= 50000 )
+ {
+ $cmdline_mysqlbinlog .=" --character-sets-dir=$path_charsetsdir";
+ }
+ # Always use the given tmpdir for the LOAD files created
+ # by mysqlbinlog
+ $cmdline_mysqlbinlog .=" --local-load=$opt_tmpdir";
+
+ if ( $opt_debug )
+ {
+ $cmdline_mysqlbinlog .=
+ " --debug=d:t:A,$path_vardir_trace/log/mysqlbinlog.trace";
+ }
+ $ENV{'MYSQL_BINLOG'}= $cmdline_mysqlbinlog;
+
+ # ----------------------------------------------------
+ # Setup env so childs can execute mysql
+ # ----------------------------------------------------
+ my $cmdline_mysql=
+ mtr_native_path($exe_mysql) .
+ " --no-defaults --debug-check --host=localhost --user=root --password= " .
+ "--port=$master->[0]->{'port'} " .
+ "--socket=$master->[0]->{'path_sock'} ".
+ "--character-sets-dir=$path_charsetsdir";
+
+ $ENV{'MYSQL'}= $cmdline_mysql;
+
+ # ----------------------------------------------------
+ # Setup env so childs can execute bug25714
+ # ----------------------------------------------------
+ $ENV{'MYSQL_BUG25714'}= $exe_bug25714;
+
+ # ----------------------------------------------------
+ # Setup env so childs can execute mysql_client_test
+ # ----------------------------------------------------
+ $ENV{'MYSQL_CLIENT_TEST'}= mysql_client_test_arguments();
+
+ # ----------------------------------------------------
+ # Setup env so childs can execute mysql_upgrade
+ # ----------------------------------------------------
+ if ( !$opt_extern && $mysql_version_id >= 50000 )
+ {
+ $ENV{'MYSQL_UPGRADE'}= mysql_upgrade_arguments();
+ }
+
+ if ( !$opt_extern )
+ {
+ $ENV{'MYSQL_FIX_PRIVILEGE_TABLES'}= $file_mysql_fix_privilege_tables;
+ }
+
+ # ----------------------------------------------------
+ # Setup env so childs can execute my_print_defaults
+ # ----------------------------------------------------
+ $ENV{'MYSQL_MY_PRINT_DEFAULTS'}= mtr_native_path($exe_my_print_defaults);
+
+ # ----------------------------------------------------
+ # Setup env so childs can execute mysqladmin
+ # ----------------------------------------------------
+ $ENV{'MYSQLADMIN'}= mtr_native_path($exe_mysqladmin);
+
+ # ----------------------------------------------------
+ # Setup env so childs can execute perror
+ # ----------------------------------------------------
+ $ENV{'MY_PERROR'}= mtr_native_path($exe_perror);
+
+ # ----------------------------------------------------
+ # Add the path where mysqld will find udf_example.so
+ # ----------------------------------------------------
+ $ENV{'UDF_EXAMPLE_LIB'}=
+ ($lib_udf_example ? basename($lib_udf_example) : "");
+ $ENV{'UDF_EXAMPLE_LIB_OPT'}=
+ ($lib_udf_example ? "--plugin_dir=" . dirname($lib_udf_example) : "");
+
+ # ----------------------------------------------------
+ # Add the path where mysqld will find ha_example.so
+ # ----------------------------------------------------
+ $ENV{'EXAMPLE_PLUGIN'}=
+ ($lib_example_plugin ? basename($lib_example_plugin) : "");
+ $ENV{'EXAMPLE_PLUGIN_OPT'}=
+ ($lib_example_plugin ? "--plugin_dir=" . dirname($lib_example_plugin) : "");
+
+ # ----------------------------------------------------
+ # Setup env so childs can execute myisampack and myisamchk
+ # ----------------------------------------------------
+ $ENV{'MYISAMCHK'}= mtr_native_path(mtr_exe_exists(
+ vs_config_dirs('storage/myisam', 'myisamchk'),
+ vs_config_dirs('myisam', 'myisamchk'),
+ "$path_client_bindir/myisamchk",
+ "$glob_bindir/storage/myisam/myisamchk",
+ "$glob_bindir/myisam/myisamchk"));
+ $ENV{'MYISAMPACK'}= mtr_native_path(mtr_exe_exists(
+ vs_config_dirs('storage/myisam', 'myisampack'),
+ vs_config_dirs('myisam', 'myisampack'),
+ "$path_client_bindir/myisampack",
+ "$glob_bindir/storage/myisam/myisampack",
+ "$glob_bindir/myisam/myisampack"));
+
+ # ----------------------------------------------------
+ # Setup env so childs can execute aria_pack and aria_chk
+ # ----------------------------------------------------
+ $ENV{'ARIA_CHK'}= mtr_native_path(mtr_exe_maybe_exists(
+ vs_config_dirs('storage/maria', 'aria_chk'),
+ vs_config_dirs('maria', 'aria_chk'),
+ "$path_client_bindir/aria_chk",
+ "$glob_basedir/storage/maria/aria_chk",
+ "$glob_basedir/maria/aria_chk"));
+ $ENV{'ARIA_PACK'}= mtr_native_path(mtr_exe_maybe_exists(
+ vs_config_dirs('storage/maria', 'aria_pack'),
+ vs_config_dirs('maria', 'aria_pack'),
+ "$path_client_bindir/aria_pack",
+ "$glob_basedir/storage/maria/aria_pack",
+ "$glob_basedir/maria/aria_pack"));
+
+ # ----------------------------------------------------
+ # We are nice and report a bit about our settings
+ # ----------------------------------------------------
+ if (!$opt_extern)
+ {
+ print "Using MTR_BUILD_THREAD = $ENV{MTR_BUILD_THREAD}\n";
+ print "Using MASTER_MYPORT = $ENV{MASTER_MYPORT}\n";
+ print "Using MASTER_MYPORT1 = $ENV{MASTER_MYPORT1}\n";
+ print "Using SLAVE_MYPORT = $ENV{SLAVE_MYPORT}\n";
+ print "Using SLAVE_MYPORT1 = $ENV{SLAVE_MYPORT1}\n";
+ print "Using SLAVE_MYPORT2 = $ENV{SLAVE_MYPORT2}\n";
+ }
+
+ # Create an environment variable to make it possible
+ # to detect that valgrind is being used from test cases
+ $ENV{'VALGRIND_TEST'}= $opt_valgrind;
+
+}
+
+
+##############################################################################
+#
+# If we get a ^C, we try to clean up before termination
+#
+##############################################################################
+# FIXME check restrictions what to do in a signal handler
+
+sub signal_setup () {
+ $SIG{INT}= \&handle_int_signal;
+}
+
+
+sub handle_int_signal () {
+ $SIG{INT}= 'DEFAULT'; # If we get a ^C again, we die...
+ mtr_warning("got INT signal, cleaning up.....");
+ stop_all_servers();
+ mtr_error("We die from ^C signal from user");
+}
+
+
+##############################################################################
+#
+# Handle left overs from previous runs
+#
+##############################################################################
+
+sub kill_running_servers () {
+
+ if ( $opt_fast or $glob_use_embedded_server )
+ {
+ # FIXME is embedded server really using PID files?!
+ unlink($master->[0]->{'path_pid'});
+ unlink($master->[1]->{'path_pid'});
+ unlink($slave->[0]->{'path_pid'});
+ unlink($slave->[1]->{'path_pid'});
+ unlink($slave->[2]->{'path_pid'});
+ }
+ else
+ {
+ # Ensure that no old mysqld test servers are running
+ # This is different from terminating processes we have
+ # started from this run of the script, this is terminating
+ # leftovers from previous runs.
+ mtr_kill_leftovers();
+ }
+}
+
+#
+# Remove var and any directories in var/ created by previous
+# tests
+#
+sub remove_stale_vardir () {
+
+ mtr_report("Removing Stale Files");
+
+ # Safety!
+ mtr_error("No, don't remove the vardir when running with --extern")
+ if $opt_extern;
+
+ mtr_verbose("opt_vardir: $opt_vardir");
+ if ( $opt_vardir eq $default_vardir )
+ {
+ #
+ # Running with "var" in mysql-test dir
+ #
+ if ( -l $opt_vardir)
+ {
+ # var is a symlink
+
+ if ( $opt_mem and readlink($opt_vardir) eq $opt_mem )
+ {
+ # Remove the directory which the link points at
+ mtr_verbose("Removing " . readlink($opt_vardir));
+ mtr_rmtree(readlink($opt_vardir));
+
+ # Remove the "var" symlink
+ mtr_verbose("unlink($opt_vardir)");
+ unlink($opt_vardir);
+ }
+ elsif ( $opt_mem )
+ {
+ # Just remove the "var" symlink
+ mtr_report("WARNING: Removing '$opt_vardir' symlink it's wrong");
+
+ mtr_verbose("unlink($opt_vardir)");
+ unlink($opt_vardir);
+ }
+ else
+ {
+ # Some users creates a soft link in mysql-test/var to another area
+ # - allow it, but remove all files in it
+
+ mtr_report("WARNING: Using the 'mysql-test/var' symlink");
+
+ # Make sure the directory where it points exist
+ if (! -d readlink($opt_vardir))
+ {
+ mtr_report("The destination for symlink $opt_vardir does not exist; Removing it and creating a new var directory");
+ unlink($opt_vardir);
+ }
+
+ foreach my $bin ( glob("$opt_vardir/*") )
+ {
+ mtr_verbose("Removing bin $bin");
+ mtr_rmtree($bin);
+ }
+ }
+ }
+ else
+ {
+ # Remove the entire "var" dir
+ mtr_verbose("Removing $opt_vardir/");
+ mtr_rmtree("$opt_vardir/");
+ }
+
+ if ( $opt_mem )
+ {
+ # A symlink from var/ to $opt_mem will be set up
+ # remove the $opt_mem dir to assure the symlink
+ # won't point at an old directory
+ mtr_verbose("Removing $opt_mem");
+ mtr_rmtree($opt_mem);
+ }
+
+ }
+ else
+ {
+ #
+ # Running with "var" in some other place
+ #
+
+ # Remove the var/ dir in mysql-test dir if any
+ # this could be an old symlink that shouldn't be there
+ # mtr_verbose("Removing $default_vardir");
+ # mtr_rmtree($default_vardir);
+
+ # Remove the "var" dir
+ mtr_verbose("Removing $opt_vardir/");
+ mtr_rmtree("$opt_vardir/");
+ }
+}
+
+#
+# Create var and the directories needed in var
+#
+sub setup_vardir() {
+ mtr_report("Creating Directories");
+
+ if ( $opt_vardir eq $default_vardir )
+ {
+ #
+ # Running with "var" in mysql-test dir
+ #
+ if ( -l $opt_vardir )
+ {
+ # it's a symlink
+
+ # Make sure the directory where it points exist
+ if (! -d readlink($opt_vardir))
+ {
+ mtr_report("The destination for symlink $opt_vardir does not exist; Removing it and creating a new var directory");
+ unlink($opt_vardir);
+ }
+ }
+ elsif ( $opt_mem )
+ {
+ # Runinng with "var" as a link to some "memory" location, normally tmpfs
+ mtr_verbose("Creating $opt_mem");
+ mkpath($opt_mem);
+
+ mtr_report("Symlinking 'var' to '$opt_mem'");
+ symlink($opt_mem, $opt_vardir);
+ }
+ }
+
+ if ( ! -d $opt_vardir )
+ {
+ mtr_verbose("Creating $opt_vardir");
+ mkpath($opt_vardir);
+ }
+
+ # Ensure a proper error message if vardir couldn't be created
+ unless ( -d $opt_vardir and -w $opt_vardir )
+ {
+ mtr_error("Writable 'var' directory is needed, use the " .
+ "'--vardir=<path>' option");
+ }
+
+ mkpath("$opt_vardir/log");
+ mkpath("$opt_vardir/run");
+ mkpath("$opt_vardir/tmp");
+ mkpath($opt_tmpdir) if $opt_tmpdir ne "$opt_vardir/tmp";
+
+ # Create new data dirs
+ foreach my $data_dir (@data_dir_lst)
+ {
+ mkpath("$data_dir/mysql");
+ mkpath("$data_dir/test");
+ }
+
+ # Make a link std_data_ln in var/ that points to std_data
+ if ( ! $glob_win32 )
+ {
+ symlink("$glob_mysql_test_dir/std_data", "$opt_vardir/std_data_ln");
+ }
+ else
+ {
+ # on windows, copy all files from std_data into var/std_data_ln
+ mkpath("$opt_vardir/std_data_ln");
+ mtr_copy_dir("$glob_mysql_test_dir/std_data", "$opt_vardir/std_data_ln");
+ }
+
+ # Remove old log files
+ foreach my $name (glob("r/*.progress r/*.log r/*.warnings"))
+ {
+ unlink($name);
+ }
+ if ( $opt_valgrind and $opt_debug )
+ {
+ # When both --valgrind and --debug is selected, send
+ # all output to the trace file, making it possible to
+ # see the exact location where valgrind complains
+ foreach my $mysqld (@{$master}, @{$slave})
+ {
+ my $sidx= $mysqld->{idx} ? "$mysqld->{idx}" : "";
+ my $trace_name= "$opt_vardir/log/" . $mysqld->{type} . "$sidx.trace";
+ open(LOG, ">$mysqld->{path_myerr}") or die "Can't create $mysqld->{path_myerr}\n";
+ print LOG "
+NOTE: When running with --valgrind --debug the output from the .err file is
+stored together with the trace file to make it easier to find the exact
+position for valgrind errors.
+See trace file $trace_name.\n";
+ close(LOG);
+ $mysqld->{path_myerr}= $trace_name;
+ }
+ }
+}
+
+
+sub check_running_as_root () {
+ # Check if running as root
+ # i.e a file can be read regardless what mode we set it to
+ my $test_file= "$opt_vardir/test_running_as_root.txt";
+ mtr_tofile($test_file, "MySQL");
+ chmod(oct("0000"), $test_file);
+
+ my $result="";
+ if (open(FILE,"<",$test_file))
+ {
+ $result= join('', <FILE>);
+ close FILE;
+ }
+
+ # Some filesystems( for example CIFS) allows reading a file
+ # although mode was set to 0000, but in that case a stat on
+ # the file will not return 0000
+ my $file_mode= (stat($test_file))[2] & 07777;
+
+ $ENV{'MYSQL_TEST_ROOT'}= "NO";
+ mtr_verbose("result: $result, file_mode: $file_mode");
+ if ($result eq "MySQL" && $file_mode == 0)
+ {
+ mtr_warning("running this script as _root_ will cause some " .
+ "tests to be skipped");
+ $ENV{'MYSQL_TEST_ROOT'}= "YES";
+ }
+
+ chmod(oct("0755"), $test_file);
+ unlink($test_file);
+
+}
+
+
+sub check_ssl_support ($) {
+ my $mysqld_variables= shift;
+
+ if ($opt_skip_ssl || $opt_extern)
+ {
+ if (!$opt_extern)
+ {
+ mtr_report("Skipping SSL");
+ }
+ $opt_ssl_supported= 0;
+ $opt_ssl= 0;
+ return;
+ }
+
+ if ( ! $mysqld_variables->{'ssl'} )
+ {
+ if ( $opt_ssl)
+ {
+ mtr_error("Couldn't find support for SSL");
+ return;
+ }
+ mtr_report("Skipping SSL, mysqld not compiled with SSL");
+ $opt_ssl_supported= 0;
+ $opt_ssl= 0;
+ return;
+ }
+ mtr_report("Setting mysqld to support SSL connections");
+ $opt_ssl_supported= 1;
+}
+
+
+sub check_debug_support ($) {
+ my $mysqld_variables= shift;
+
+ if ( ! $mysqld_variables->{'debug'} )
+ {
+ #mtr_report("Binaries are not debug compiled");
+ $debug_compiled_binaries= 0;
+
+ if ( $opt_debug )
+ {
+ mtr_error("Can't use --debug, binaries does not support it");
+ }
+ return;
+ }
+ mtr_report("Binaries are debug compiled");
+ $debug_compiled_binaries= 1;
+}
+
+##############################################################################
+#
+# Helper function to handle configuration-based subdirectories which Visual
+# Studio uses for storing binaries. If opt_vs_config is set, this returns
+# a path based on that setting; if not, it returns paths for the default
+# /release/ and /debug/ subdirectories.
+#
+# $exe can be undefined, if the directory itself will be used
+#
+###############################################################################
+
+sub vs_config_dirs ($$) {
+ my ($path_part, $exe) = @_;
+
+ $exe = "" if not defined $exe;
+
+ if ($multiconfig)
+ {
+ return ("$glob_bindir/$path_part/$multiconfig/$exe");
+ }
+
+ return ("$glob_bindir/$path_part/release/$exe",
+ "$glob_bindir/$path_part/relwithdebinfo/$exe",
+ "$glob_bindir/$path_part/debug/$exe");
+}
+
+sub mysqld_wait_started($){
+ my $mysqld= shift;
+
+ if (sleep_until_file_created($mysqld->{'path_pid'},
+ $mysqld->{'start_timeout'},
+ $mysqld->{'pid'}) == 0)
+ {
+ # Failed to wait for pid file
+ return 1;
+ }
+
+ # Get the "real pid" of the process, it will be used for killing
+ # the process in ActiveState's perl on windows
+ $mysqld->{'real_pid'}= mtr_get_pid_from_file($mysqld->{'path_pid'});
+
+ return 0;
+}
+
+
+##############################################################################
+#
+# Run the benchmark suite
+#
+##############################################################################
+
+sub run_benchmarks ($) {
+ my $benchmark= shift;
+
+ my $args;
+
+ if ( ! $glob_use_embedded_server )
+ {
+ mysqld_start($master->[0],[],[]);
+ if ( ! $master->[0]->{'pid'} )
+ {
+ mtr_error("Can't start the mysqld server");
+ }
+ }
+
+ mtr_init_args(\$args);
+
+ mtr_add_arg($args, "--socket=%s", $master->[0]->{'path_sock'});
+ mtr_add_arg($args, "--user=%s", $opt_user);
+
+ if ( $opt_small_bench )
+ {
+ mtr_add_arg($args, "--small-test");
+ mtr_add_arg($args, "--small-tables");
+ }
+
+ chdir($glob_mysql_bench_dir)
+ or mtr_error("Couldn't chdir to '$glob_mysql_bench_dir': $!");
+
+ if ( ! $benchmark )
+ {
+ mtr_add_arg($args, "--general-log");
+ mtr_run("$glob_mysql_bench_dir/run-all-tests", $args, "", "", "", "");
+ # FIXME check result code?!
+ }
+ elsif ( -x $benchmark )
+ {
+ mtr_run("$glob_mysql_bench_dir/$benchmark", $args, "", "", "", "");
+ # FIXME check result code?!
+ }
+ else
+ {
+ mtr_error("Benchmark $benchmark not found");
+ }
+
+ chdir($glob_mysql_test_dir); # Go back
+
+ if ( ! $glob_use_embedded_server )
+ {
+ stop_masters();
+ }
+}
+
+
+##############################################################################
+#
+# Run the tests
+#
+##############################################################################
+
+sub run_tests () {
+ my ($tests)= @_;
+
+ mtr_print_thick_line();
+
+ mtr_timer_start($glob_timers,"suite", 60 * $opt_suite_timeout);
+
+ mtr_report_tests_not_skipped_though_disabled($tests);
+
+ mtr_print_header();
+
+ foreach my $tinfo ( @$tests )
+ {
+ if (run_testcase_check_skip_test($tinfo))
+ {
+ next;
+ }
+
+ mtr_timer_start($glob_timers,"testcase", 60 * $opt_testcase_timeout);
+ run_testcase($tinfo);
+ mtr_timer_stop($glob_timers,"testcase");
+ }
+
+ mtr_print_line();
+
+ if ( ! $glob_debugger and
+ ! $opt_extern and
+ ! $glob_use_embedded_server )
+ {
+ stop_all_servers();
+ }
+
+ if ( $opt_gcov )
+ {
+ gcov_collect(); # collect coverage information
+ }
+ if ( $opt_gprof )
+ {
+ gprof_collect(); # collect coverage information
+ }
+
+ mtr_report_stats($tests);
+
+ mtr_timer_stop($glob_timers,"suite");
+}
+
+
+##############################################################################
+#
+# Initiate the test databases
+#
+##############################################################################
+
+sub initialize_servers () {
+
+ datadir_list_setup();
+
+ if ( $opt_extern )
+ {
+ # Running against an already started server, if the specified
+ # vardir does not already exist it should be created
+ if ( ! -d $opt_vardir )
+ {
+ mtr_report("Creating '$opt_vardir'");
+ setup_vardir();
+ }
+ else
+ {
+ mtr_verbose("No need to create '$opt_vardir' it already exists");
+ }
+ }
+ else
+ {
+ kill_running_servers();
+
+ if ( ! $opt_start_dirty )
+ {
+ remove_stale_vardir();
+ setup_vardir();
+
+ mysql_install_db();
+ if ( $opt_force )
+ {
+ # Save a snapshot of the freshly installed db
+ # to make it possible to restore to a known point in time
+ save_installed_db();
+ }
+ }
+ }
+ check_running_as_root();
+
+ mtr_log_init("$opt_vardir/log/mysql-test-run.log");
+
+}
+
+sub mysql_install_db () {
+
+ install_db('master', $master->[0]->{'path_myddir'});
+
+ if ($max_master_num > 1)
+ {
+ copy_install_db('master', $master->[1]->{'path_myddir'});
+ }
+
+ # Install the number of slave databses needed
+ for (my $idx= 0; $idx < $max_slave_num; $idx++)
+ {
+ copy_install_db("slave".($idx+1), $slave->[$idx]->{'path_myddir'});
+ }
+
+ return 0;
+}
+
+
+sub copy_install_db ($$) {
+ my $type= shift;
+ my $data_dir= shift;
+
+ mtr_report("Installing \u$type Database");
+
+ # Just copy the installed db from first master
+ mtr_copy_dir($master->[0]->{'path_myddir'}, $data_dir);
+
+}
+
+
+sub install_db ($$) {
+ my $type= shift;
+ my $data_dir= shift;
+
+ mtr_report("Installing \u$type Database");
+
+ my $args;
+ my $cmd_args;
+ mtr_init_args(\$args);
+ mtr_add_arg($args, "--no-defaults");
+ mtr_add_arg($args, "--bootstrap");
+ mtr_add_arg($args, "--basedir=%s", $glob_basedir);
+ mtr_add_arg($args, "--datadir=%s", $data_dir);
+ mtr_add_arg($args, "--loose-skip-aria");
+ mtr_add_arg($args, "--disable-sync-frm");
+ mtr_add_arg($args, "--loose-disable-debug");
+ mtr_add_arg($args, "--tmpdir=.");
+ mtr_add_arg($args, "--core-file");
+
+ #
+ # Setup args for bootstrap.test
+ #
+ mtr_init_args(\$cmd_args);
+ mtr_add_arg($cmd_args, "--loose-skip-aria");
+
+ if ( $opt_debug )
+ {
+ mtr_add_arg($args, "--debug=d:t:i:A,%s/log/bootstrap_%s.trace",
+ $path_vardir_trace, $type);
+ }
+
+ mtr_add_arg($args, "--lc-messages-dir=%s", $path_language);
+ mtr_add_arg($args, "--character-sets-dir=%s", $path_charsetsdir);
+
+ # InnoDB arguments that affect file location and sizes may
+ # need to be given to the bootstrap process as well as the
+ # server process.
+ foreach my $extra_opt ( @opt_extra_mysqld_opt ) {
+ if ($extra_opt =~ /--innodb/) {
+ mtr_add_arg($args, $extra_opt);
+ }
+ }
+
+ # If DISABLE_GRANT_OPTIONS is defined when the server is compiled (e.g.,
+ # configure --disable-grant-options), mysqld will not recognize the
+ # --bootstrap or --skip-grant-tables options. The user can set
+ # MYSQLD_BOOTSTRAP to the full path to a mysqld which does accept
+ # --bootstrap, to accommodate this.
+ my $exe_mysqld_bootstrap = $ENV{'MYSQLD_BOOTSTRAP'} || $exe_mysqld;
+
+ # ----------------------------------------------------------------------
+ # export MYSQLD_BOOTSTRAP_CMD variable containing <path>/mysqld <args>
+ # ----------------------------------------------------------------------
+ $ENV{'MYSQLD_BOOTSTRAP_CMD'}= "$exe_mysqld_bootstrap " . join(" ", @$args) .
+ " " . join(" ", @$cmd_args);
+
+ # ----------------------------------------------------------------------
+ # Create the bootstrap.sql file
+ # ----------------------------------------------------------------------
+ my $bootstrap_sql_file= "$opt_vardir/tmp/bootstrap.sql";
+
+ # Use the mysql database for system tables
+ mtr_tofile($bootstrap_sql_file, "use mysql;\n");
+
+ # Add the offical mysql system tables
+ # for a production system
+ mtr_appendfile_to_file("$path_sql_dir/mysql_system_tables.sql",
+ $bootstrap_sql_file);
+ mtr_appendfile_to_file("$path_sql_dir/mysql_performance_tables.sql",
+ $bootstrap_sql_file);
+
+ # Add the mysql system tables initial data
+ # for a production system
+ mtr_appendfile_to_file("$path_sql_dir/mysql_system_tables_data.sql",
+ $bootstrap_sql_file);
+
+ # Add test data for timezone - this is just a subset, on a real
+ # system these tables will be populated either by mysql_tzinfo_to_sql
+ # or by downloading the timezone table package from our website
+ mtr_appendfile_to_file("$path_sql_dir/mysql_test_data_timezone.sql",
+ $bootstrap_sql_file);
+
+ # Fill help tables, just an empty file when running from bk repo
+ # but will be replaced by a real fill_help_tables.sql when
+ # building the source dist
+ mtr_appendfile_to_file("$path_sql_dir/fill_help_tables.sql",
+ $bootstrap_sql_file);
+
+ # Remove anonymous users
+ mtr_tofile($bootstrap_sql_file,
+ "DELETE FROM mysql.user where user= '';");
+
+ # Log bootstrap command
+ my $path_bootstrap_log= "$opt_vardir/log/bootstrap.log";
+ mtr_tofile($path_bootstrap_log,
+ "$exe_mysqld_bootstrap " . join(" ", @$args) . "\n");
+
+
+ if ( mtr_run($exe_mysqld_bootstrap, $args, $bootstrap_sql_file,
+ $path_bootstrap_log, $path_bootstrap_log,
+ "", { append_log_file => 1 }) != 0 )
+
+ {
+ mtr_error("Error executing mysqld --bootstrap\n" .
+ "Could not install system database from $bootstrap_sql_file\n" .
+ "see $path_bootstrap_log for errors");
+ }
+}
+
+
+#
+# Restore snapshot of the installed slave databases
+# if the snapshot exists
+#
+sub restore_slave_databases ($) {
+ my ($num_slaves)= @_;
+
+ if ( -d $path_snapshot)
+ {
+ for (my $idx= 0; $idx < $num_slaves; $idx++)
+ {
+ my $data_dir= $slave->[$idx]->{'path_myddir'};
+ my $name= basename($data_dir);
+ mtr_rmtree($data_dir);
+ mtr_copy_dir("$path_snapshot/$name", $data_dir);
+ }
+ }
+}
+
+
+sub run_testcase_check_skip_test($)
+{
+ my ($tinfo)= @_;
+
+ # ----------------------------------------------------------------------
+ # Skip some tests silently
+ # ----------------------------------------------------------------------
+
+ if ( $::opt_start_from )
+ {
+ if ($tinfo->{'name'} eq $::opt_start_from )
+ {
+ ## Found parting test. Run this test and all tests after this one
+ $::opt_start_from= "";
+ }
+ else
+ {
+ $tinfo->{'result'}= 'MTR_RES_SKIPPED';
+ return 1;
+ }
+ }
+
+ # ----------------------------------------------------------------------
+ # If marked to skip, just print out and return.
+ # Note that a test case not marked as 'skip' can still be
+ # skipped later, because of the test case itself in cooperation
+ # with the mysqltest program tells us so.
+ # ----------------------------------------------------------------------
+
+ if ( $tinfo->{'skip'} )
+ {
+ mtr_report_test_name($tinfo);
+ mtr_report_test_skipped($tinfo);
+ return 1;
+ }
+
+ return 0;
+}
+
+
+sub do_before_run_mysqltest($)
+{
+ my $tinfo= shift;
+ my $args;
+
+ # Remove old files produced by mysqltest
+ my $base_file= mtr_match_extension($tinfo->{'result_file'},
+ "result"); # Trim extension
+ unlink("$base_file.reject");
+ unlink("$base_file.progress");
+ unlink("$base_file.log");
+ unlink("$base_file.warnings");
+
+ if (!$opt_extern)
+ {
+ if (defined $tinfo->{binlog_format} and $mysql_version_id > 50100 )
+ {
+ # Dynamically switch binlog format of
+ # master, slave is always restarted
+ foreach my $server ( @$master )
+ {
+ next unless ($server->{'pid'});
+
+ mtr_init_args(\$args);
+ mtr_add_arg($args, "--no-defaults");
+ mtr_add_arg($args, "--user=root");
+ mtr_add_arg($args, "--port=$server->{'port'}");
+ mtr_add_arg($args, "--socket=$server->{'path_sock'}");
+
+ my $sql= "include/set_binlog_format_".$tinfo->{binlog_format}.".sql";
+ mtr_verbose("Setting binlog format:", $tinfo->{binlog_format});
+ if (mtr_run($exe_mysql, $args, $sql, "", "", "") != 0)
+ {
+ mtr_error("Failed to switch binlog format");
+ }
+ }
+ }
+ }
+}
+
+sub do_after_run_mysqltest($)
+{
+ my $tinfo= shift;
+
+ # Save info from this testcase run to mysqltest.log
+ mtr_appendfile_to_file($path_current_test_log, $path_mysqltest_log)
+ if -f $path_current_test_log;
+ mtr_appendfile_to_file($path_timefile, $path_mysqltest_log)
+ if -f $path_timefile;
+}
+
+
+sub run_testcase_mark_logs($$)
+{
+ my ($tinfo, $log_msg)= @_;
+
+ # Write a marker to all log files
+
+ # The file indicating current test name
+ mtr_tonewfile($path_current_test_log, $log_msg);
+
+ # each mysqld's .err file
+ foreach my $mysqld (@{$master}, @{$slave})
+ {
+ mtr_tofile($mysqld->{path_myerr}, $log_msg);
+ }
+}
+
+sub find_testcase_skipped_reason($)
+{
+ my ($tinfo)= @_;
+
+ # Set default message
+ $tinfo->{'comment'}= "Detected by testcase(no log file)";
+
+ # Open mysqltest-time(the mysqltest log file)
+ my $F= IO::File->new($path_timefile)
+ or return;
+ my $reason;
+
+ while ( my $line= <$F> )
+ {
+ # Look for "reason: <reason for skipping test>"
+ if ( $line =~ /reason: (.*)/ )
+ {
+ $reason= $1;
+ }
+ }
+
+ if ( ! $reason )
+ {
+ mtr_warning("Could not find reason for skipping test in $path_timefile");
+ $reason= "Detected by testcase(reason unknown) ";
+ }
+ $tinfo->{'comment'}= $reason;
+}
+
+
+##############################################################################
+#
+# Run a single test case
+#
+##############################################################################
+
+# When we get here, we have already filtered out test cases that doesn't
+# apply to the current setup, for example if we use a running server, test
+# cases that restart the server are dropped. So this function should mostly
+# be about doing things, not a lot of logic.
+
+# We don't start and kill the servers for each testcase. But some
+# testcases needs a restart, because they specify options to start
+# mysqld with. After that testcase, we need to restart again, to set
+# back the normal options.
+
+sub run_testcase ($) {
+ my $tinfo= shift;
+
+ # -------------------------------------------------------
+ # Init variables that can change between each test case
+ # -------------------------------------------------------
+
+ $ENV{'TZ'}= $tinfo->{'timezone'};
+ mtr_verbose("Setting timezone: $tinfo->{'timezone'}");
+
+ my $master_restart= run_testcase_need_master_restart($tinfo);
+ my $slave_restart= run_testcase_need_slave_restart($tinfo);
+
+ if ($master_restart or $slave_restart)
+ {
+ # Can't restart a running server that may be in use
+ if ( $opt_extern )
+ {
+ mtr_report_test_name($tinfo);
+ $tinfo->{comment}= "Can't restart a running server";
+ mtr_report_test_skipped($tinfo);
+ return;
+ }
+
+ run_testcase_stop_servers($tinfo, $master_restart, $slave_restart);
+ }
+
+ # Write to all log files to indicate start of testcase
+ run_testcase_mark_logs($tinfo, "CURRENT_TEST: $tinfo->{name}\n");
+
+ my $died= mtr_record_dead_children();
+ if ($died or $master_restart or $slave_restart)
+ {
+ if (run_testcase_start_servers($tinfo))
+ {
+ mtr_report_test_name($tinfo);
+ report_failure_and_restart($tinfo);
+ return 1;
+ }
+ }
+ elsif ($glob_use_embedded_server)
+ {
+ run_master_init_script($tinfo);
+ }
+
+ # ----------------------------------------------------------------------
+ # If --start-and-exit or --start-dirty given, stop here to let user manually
+ # run tests
+ # ----------------------------------------------------------------------
+ if ( $opt_start_and_exit or $opt_start_dirty )
+ {
+ mtr_timer_stop_all($glob_timers);
+ mtr_report("\nServers started, exiting");
+ if ($glob_win32_perl)
+ {
+ #ActiveState perl hangs when using normal exit, use POSIX::_exit instead
+ use POSIX qw[ _exit ];
+ POSIX::_exit(0);
+ }
+ else
+ {
+ exit(0);
+ }
+ }
+
+ {
+ do_before_run_mysqltest($tinfo);
+
+ my $res= run_mysqltest($tinfo);
+ mtr_report_test_name($tinfo);
+
+ do_after_run_mysqltest($tinfo);
+
+ if ( $res == 0 )
+ {
+ mtr_report_test_passed($tinfo);
+ }
+ elsif ( $res == 62 )
+ {
+ # Testcase itself tell us to skip this one
+
+ # Try to get reason from mysqltest.log
+ find_testcase_skipped_reason($tinfo);
+ mtr_report_test_skipped($tinfo);
+ }
+ elsif ( $res == 63 )
+ {
+ $tinfo->{'timeout'}= 1; # Mark as timeout
+ report_failure_and_restart($tinfo);
+ }
+ elsif ( $res == 1 )
+ {
+ # Test case failure reported by mysqltest
+ report_failure_and_restart($tinfo);
+ }
+ else
+ {
+ # mysqltest failed, probably crashed
+ $tinfo->{comment}=
+ "mysqltest returned unexpected code $res, it has probably crashed";
+ report_failure_and_restart($tinfo);
+ }
+ }
+
+ # Remove the file that mysqltest writes info to
+ unlink($path_timefile);
+}
+
+
+#
+# Save a snapshot of the installed test db(s)
+# I.e take a snapshot of the var/ dir
+#
+sub save_installed_db () {
+
+ mtr_report("Saving snapshot of installed databases");
+ mtr_rmtree($path_snapshot);
+
+ foreach my $data_dir (@data_dir_lst)
+ {
+ my $name= basename($data_dir);
+ mtr_copy_dir("$data_dir", "$path_snapshot/$name");
+ }
+}
+
+
+#
+# Save any interesting files in the data_dir
+# before the data dir is removed.
+#
+sub save_files_before_restore($$) {
+ my $test_name= shift;
+ my $data_dir= shift;
+ my $save_name= "$opt_vardir/log/$test_name";
+
+ # Look for core files
+ foreach my $core_file ( glob("$data_dir/core*") )
+ {
+ last if $opt_max_save_core > 0 && $num_saved_cores >= $opt_max_save_core;
+ my $core_name= basename($core_file);
+ mtr_report("Saving $core_name");
+ mkdir($save_name) if ! -d $save_name;
+ rename("$core_file", "$save_name/$core_name");
+ ++$num_saved_cores;
+ }
+}
+
+
+#
+# Restore snapshot of the installed test db(s)
+# if the snapshot exists
+#
+sub restore_installed_db ($) {
+ my $test_name= shift;
+
+ if ( -d $path_snapshot)
+ {
+ mtr_report("Restoring snapshot of databases");
+
+ foreach my $data_dir (@data_dir_lst)
+ {
+ my $name= basename($data_dir);
+ save_files_before_restore($test_name, $data_dir);
+ mtr_rmtree("$data_dir");
+ mtr_copy_dir("$path_snapshot/$name", "$data_dir");
+ }
+ }
+ else
+ {
+ # No snapshot existed
+ mtr_error("No snapshot existed");
+ }
+}
+
+sub report_failure_and_restart ($) {
+ my $tinfo= shift;
+
+ mtr_report_test_failed($tinfo);
+ print "\n";
+ if ( $opt_force )
+ {
+ # Stop all servers that are known to be running
+ stop_all_servers();
+
+ # Restore the snapshot of the installed test db
+ restore_installed_db($tinfo->{'name'});
+ mtr_report("Resuming Tests\n");
+ return;
+ }
+
+ my $test_mode= join(" ", @::glob_test_mode) || "default";
+ mtr_report("Aborting: $tinfo->{'name'} failed in $test_mode mode. ");
+ mtr_report("To continue, re-run with '--force'.");
+ if ( ! $glob_debugger and
+ ! $opt_extern and
+ ! $glob_use_embedded_server )
+ {
+ stop_all_servers();
+ }
+ mtr_exit(1);
+
+}
+
+
+sub run_master_init_script ($) {
+ my ($tinfo)= @_;
+ my $init_script= $tinfo->{'master_sh'};
+
+ # Run master initialization shell script if one exists
+ if ( $init_script )
+ {
+ my $ret= mtr_run("/bin/sh", [$init_script], "", "", "", "");
+ if ( $ret != 0 )
+ {
+ # FIXME rewrite those scripts to return 0 if successful
+ # mtr_warning("$init_script exited with code $ret");
+ }
+ }
+}
+
+
+##############################################################################
+#
+# Start and stop servers
+#
+##############################################################################
+
+
+sub do_before_start_master ($) {
+ my ($tinfo)= @_;
+
+ my $tname= $tinfo->{'name'};
+
+ # FIXME what about second master.....
+
+ # Don't delete anything if starting dirty
+ return if ($opt_start_dirty);
+
+ foreach my $bin ( glob("$opt_vardir/log/master*-bin*") )
+ {
+ unlink($bin);
+ }
+
+ # FIXME only remove the ones that are tied to this master
+ # Remove old master.info and relay-log.info files
+ unlink("$master->[0]->{'path_myddir'}/master.info");
+ unlink("$master->[0]->{'path_myddir'}/relay-log.info");
+ unlink("$master->[1]->{'path_myddir'}/master.info");
+ unlink("$master->[1]->{'path_myddir'}/relay-log.info");
+
+ run_master_init_script($tinfo);
+}
+
+
+sub do_before_start_slave ($) {
+ my ($tinfo)= @_;
+
+ my $tname= $tinfo->{'name'};
+ my $init_script= $tinfo->{'master_sh'};
+
+ # Don't delete anything if starting dirty
+ return if ($opt_start_dirty);
+
+ foreach my $bin ( glob("$opt_vardir/log/slave*-bin*") )
+ {
+ unlink($bin);
+ }
+
+ unlink("$slave->[0]->{'path_myddir'}/master.info");
+ unlink("$slave->[0]->{'path_myddir'}/relay-log.info");
+
+ # Run slave initialization shell script if one exists
+ if ( $init_script )
+ {
+ my $ret= mtr_run("/bin/sh", [$init_script], "", "", "", "");
+ if ( $ret != 0 )
+ {
+ # FIXME rewrite those scripts to return 0 if successful
+ # mtr_warning("$init_script exited with code $ret");
+ }
+ }
+
+ foreach my $bin ( glob("$slave->[0]->{'path_myddir'}/log.*") )
+ {
+ unlink($bin);
+ }
+}
+
+
+sub mysqld_arguments ($$$$) {
+ my $args= shift;
+ my $mysqld= shift;
+ my $extra_opt= shift;
+ my $slave_master_info= shift;
+
+ my $idx= $mysqld->{'idx'};
+ my $sidx= ""; # Index as string, 0 is empty string
+ if ( $idx> 0 )
+ {
+ $sidx= $idx;
+ }
+
+ my $prefix= ""; # If mysqltest server arg
+ if ( $glob_use_embedded_server )
+ {
+ $prefix= "--server-arg=";
+ }
+
+ mtr_add_arg($args, "%s--no-defaults", $prefix);
+
+ mtr_add_arg($args, "%s--basedir=%s", $prefix, $glob_basedir);
+ mtr_add_arg($args, "%s--character-sets-dir=%s", $prefix, $path_charsetsdir);
+
+ if ( $mysql_version_id >= 50036)
+ {
+ # By default, prevent the started mysqld to access files outside of vardir
+ mtr_add_arg($args, "%s--secure-file-priv=%s", $prefix, $opt_vardir);
+ }
+
+ if ( $mysql_version_id >= 50000 )
+ {
+ mtr_add_arg($args, "%s--log-bin-trust-function-creators", $prefix);
+ }
+
+ mtr_add_arg($args, "%s--character-set-server=latin1", $prefix);
+ mtr_add_arg($args, "%s--lc-messages-dir=%s", $prefix, $path_language);
+ mtr_add_arg($args, "%s--tmpdir=$opt_tmpdir", $prefix);
+
+ # Increase default connect_timeout to avoid intermittent
+ # disconnects when test servers are put under load
+ # see BUG#28359
+ mtr_add_arg($args, "%s--connect-timeout=60", $prefix);
+
+
+ # When mysqld is run by a root user(euid is 0), it will fail
+ # to start unless we specify what user to run as, see BUG#30630
+ my $euid= $>;
+ if (!$glob_win32 and $euid == 0 and
+ grep(/^--user/, @$extra_opt, @opt_extra_mysqld_opt) == 0) {
+ mtr_add_arg($args, "%s--user=root", $prefix);
+ }
+
+ if ( $opt_valgrind_mysqld )
+ {
+ if ( $mysql_version_id < 50100 )
+ {
+ mtr_add_arg($args, "%s--skip-bdb", $prefix);
+ }
+ }
+
+ mtr_add_arg($args, "%s--pid-file=%s", $prefix,
+ $mysqld->{'path_pid'});
+
+ mtr_add_arg($args, "%s--port=%d", $prefix,
+ $mysqld->{'port'});
+
+ mtr_add_arg($args, "%s--socket=%s", $prefix,
+ $mysqld->{'path_sock'});
+
+ mtr_add_arg($args, "%s--datadir=%s", $prefix,
+ $mysqld->{'path_myddir'});
+
+ mtr_add_arg($args, "%s--disable-sync-frm", $prefix); # Faster test
+
+ if (!$opt_extern and $mysql_version_id >= 50106 )
+ {
+ # Turn on logging to bothe tables and file
+ mtr_add_arg($args, "%s--log-output=table,file", $prefix);
+ }
+
+ my $log_base_path= "$opt_vardir/log/$mysqld->{'type'}$sidx";
+ mtr_add_arg($args, "%s--general-log-file=%s.log",
+ $prefix, $log_base_path);
+ mtr_add_arg($args, "%s--general-log", $prefix);
+ mtr_add_arg($args,
+ "%s--slow-query-log-file=%s-slow.log",
+ $prefix, $log_base_path);
+ mtr_add_arg($args, "%s--slow-query-log", $prefix);
+
+ # Check if "extra_opt" contains --skip-log-bin
+ my $skip_binlog= grep(/^--skip-log-bin/, @$extra_opt, @opt_extra_mysqld_opt);
+ if ( $mysqld->{'type'} eq 'master' )
+ {
+ if (! ($opt_skip_master_binlog || $skip_binlog) )
+ {
+ mtr_add_arg($args, "%s--log-bin=%s/log/master-bin%s", $prefix,
+ $opt_vardir, $sidx);
+ }
+
+ mtr_add_arg($args, "%s--server-id=%d", $prefix,
+ $idx > 0 ? $idx + 101 : 1);
+
+ mtr_add_arg($args, "%s--loose-innodb_data_file_path=ibdata1:10M:autoextend",
+ $prefix);
+
+ mtr_add_arg($args, "%s--local-infile", $prefix);
+ }
+ else
+ {
+ mtr_error("unknown mysqld type")
+ unless $mysqld->{'type'} eq 'slave';
+
+ mtr_add_arg($args, "%s--init-rpl-role=slave", $prefix);
+ if (! ( $opt_skip_slave_binlog || $skip_binlog ))
+ {
+ mtr_add_arg($args, "%s--log-bin=%s/log/slave%s-bin", $prefix,
+ $opt_vardir, $sidx); # FIXME use own dir for binlogs
+ mtr_add_arg($args, "%s--log-slave-updates", $prefix);
+ }
+
+ mtr_add_arg($args, "%s--master-retry-count=10", $prefix);
+
+ mtr_add_arg($args, "%s--relay-log=%s/log/slave%s-relay-bin", $prefix,
+ $opt_vardir, $sidx);
+ mtr_add_arg($args, "%s--report-host=127.0.0.1", $prefix);
+ mtr_add_arg($args, "%s--report-port=%d", $prefix,
+ $mysqld->{'port'});
+ mtr_add_arg($args, "%s--report-user=root", $prefix);
+ mtr_add_arg($args, "%s--loose-skip-innodb", $prefix);
+ mtr_add_arg($args, "%s--skip-slave-start", $prefix);
+
+ # Directory where slaves find the dumps generated by "load data"
+ # on the server. The path need to have constant length otherwise
+ # test results will vary, thus a relative path is used.
+ my $slave_load_path= "../tmp";
+ mtr_add_arg($args, "%s--slave-load-tmpdir=%s", $prefix,
+ $slave_load_path);
+ mtr_add_arg($args, "%s--slave_net_timeout=120", $prefix);
+
+ if ( @$slave_master_info )
+ {
+ foreach my $arg ( @$slave_master_info )
+ {
+ mtr_add_arg($args, "%s%s", $prefix, $arg);
+ }
+ }
+ else
+ {
+# NOTE: the backport (see BUG#48048) originally removed the
+# commented out lines below. However, given that they are
+# protected with a version check (< 50200) now, it should be
+# safe to keep them. The problem is that the backported patch
+# was into a 5.1 GA codebase - mysql-5.1-rep+2 tree - so
+# version is 501XX, consequently check becomes worthless. It
+# should be safe to uncomment them when merging up to 5.5.
+#
+# RQG semisync test runs on the 5.1 GA tree and needs MTR v1.
+# This was causing the test to fail (slave would not start
+# due to unrecognized option(s)).
+# if ($mysql_version_id < 50200)
+# {
+# mtr_add_arg($args, "%s--master-user=root", $prefix);
+# mtr_add_arg($args, "%s--master-connect-retry=1", $prefix);
+# mtr_add_arg($args, "%s--master-host=127.0.0.1", $prefix);
+# mtr_add_arg($args, "%s--master-password=", $prefix);
+# mtr_add_arg($args, "%s--master-port=%d", $prefix,
+# $master->[0]->{'port'}); # First master
+# }
+ my $slave_server_id= 2 + $idx;
+ my $slave_rpl_rank= $slave_server_id;
+ mtr_add_arg($args, "%s--server-id=%d", $prefix, $slave_server_id);
+ mtr_add_arg($args, "%s--rpl-recovery-rank=%d", $prefix, $slave_rpl_rank);
+ }
+ } # end slave
+
+ if ( $debug_compiled_binaries && defined $opt_debug )
+ {
+ if ( $opt_debug )
+ {
+ mtr_add_arg($args, "%s--debug=d:t:i:A,%s/log/%s%s.trace",
+ $prefix, $path_vardir_trace, $mysqld->{'type'}, $sidx);
+ }
+ else
+ {
+ mtr_add_arg($args, "--disable-debug");
+ }
+ }
+
+ mtr_add_arg($args, "%s--key_buffer_size=1M", $prefix);
+ mtr_add_arg($args, "%s--sort_buffer_size=256K", $prefix);
+ mtr_add_arg($args, "%s--max_heap_table_size=1M", $prefix);
+
+ if ( $opt_ssl_supported )
+ {
+ mtr_add_arg($args, "%s--ssl-ca=%s/std_data/cacert.pem", $prefix,
+ $glob_mysql_test_dir);
+ mtr_add_arg($args, "%s--ssl-cert=%s/std_data/server-cert.pem", $prefix,
+ $glob_mysql_test_dir);
+ mtr_add_arg($args, "%s--ssl-key=%s/std_data/server-key.pem", $prefix,
+ $glob_mysql_test_dir);
+ }
+
+ if ( $opt_warnings )
+ {
+ mtr_add_arg($args, "%s--log-warnings", $prefix);
+ }
+
+ # Indicate to "mysqld" it will be debugged in debugger
+ if ( $glob_debugger )
+ {
+ mtr_add_arg($args, "%s--gdb", $prefix);
+ }
+
+ my $found_skip_core= 0;
+ foreach my $arg ( @opt_extra_mysqld_opt, @$extra_opt )
+ {
+ # Allow --skip-core-file to be set in <testname>-[master|slave].opt file
+ if ($arg eq "--skip-core-file")
+ {
+ $found_skip_core= 1;
+ }
+ elsif ($skip_binlog and mtr_match_prefix($arg, "--binlog-format"))
+ {
+ ; # Dont add --binlog-format when running without binlog
+ }
+ else
+ {
+ mtr_add_arg($args, "%s%s", $prefix, $arg);
+ }
+ }
+ if ( !$found_skip_core )
+ {
+ mtr_add_arg($args, "%s%s", $prefix, "--core-file");
+ }
+
+ if ( $opt_bench )
+ {
+ mtr_add_arg($args, "%s--rpl-recovery-rank=1", $prefix);
+ mtr_add_arg($args, "%s--init-rpl-role=master", $prefix);
+ }
+ elsif ( $mysqld->{'type'} eq 'master' )
+ {
+ mtr_add_arg($args, "%s--open-files-limit=1024", $prefix);
+ }
+
+ return $args;
+}
+
+
+##############################################################################
+#
+# Start mysqld and return the PID
+#
+##############################################################################
+
+sub mysqld_start ($$$) {
+ my $mysqld= shift;
+ my $extra_opt= shift;
+ my $slave_master_info= shift;
+
+ my $args; # Arg vector
+ my $exe;
+ my $pid= -1;
+ my $wait_for_pid_file= 1;
+
+ my $type= $mysqld->{'type'};
+ my $idx= $mysqld->{'idx'};
+
+ mtr_error("Internal error: mysqld should never be started for embedded")
+ if $glob_use_embedded_server;
+
+ if ( $type eq 'master' )
+ {
+ $exe= $exe_master_mysqld;
+ }
+ elsif ( $type eq 'slave' )
+ {
+ $exe= $exe_slave_mysqld;
+ }
+ else
+ {
+ mtr_error("Unknown 'type' \"$type\" passed to mysqld_start");
+ }
+
+ mtr_init_args(\$args);
+
+ if ( $opt_valgrind_mysqld )
+ {
+ valgrind_arguments($args, \$exe);
+ }
+
+ mysqld_arguments($args,$mysqld,$extra_opt,$slave_master_info);
+
+ if ( $opt_gdb || $opt_manual_gdb)
+ {
+ gdb_arguments(\$args, \$exe, "$type"."_$idx");
+ }
+ elsif ( $opt_ddd || $opt_manual_ddd )
+ {
+ ddd_arguments(\$args, \$exe, "$type"."_$idx");
+ }
+ elsif ( $opt_debugger )
+ {
+ debugger_arguments(\$args, \$exe, "$type"."_$idx");
+ }
+ elsif ( $opt_manual_debug )
+ {
+ print "\nStart $type in your debugger\n" .
+ "dir: $glob_mysql_test_dir\n" .
+ "exe: $exe\n" .
+ "args: " . join(" ", @$args) . "\n\n" .
+ "Waiting ....\n";
+
+ # Indicate the exe should not be started
+ $exe= undef;
+ }
+ else
+ {
+ # Default to not wait until pid file has been created
+ $wait_for_pid_file= 0;
+ }
+
+ # Remove the pidfile
+ unlink($mysqld->{'path_pid'});
+
+ if ( defined $exe )
+ {
+ $pid= mtr_spawn($exe, $args, "",
+ $mysqld->{'path_myerr'},
+ $mysqld->{'path_myerr'},
+ "",
+ { append_log_file => 1 });
+ }
+
+
+ if ( $wait_for_pid_file && !sleep_until_file_created($mysqld->{'path_pid'},
+ $mysqld->{'start_timeout'},
+ $pid))
+ {
+
+ mtr_error("Failed to start mysqld $mysqld->{'type'}");
+ }
+
+
+ # Remember pid of the started process
+ $mysqld->{'pid'}= $pid;
+
+ # Remember options used when starting
+ $mysqld->{'start_opts'}= $extra_opt;
+ $mysqld->{'start_slave_master_info'}= $slave_master_info;
+
+ mtr_verbose("mysqld pid: $pid");
+ return $pid;
+}
+
+
+sub stop_all_servers () {
+
+ mtr_report("Stopping All Servers");
+
+ my %admin_pids; # hash of admin processes that requests shutdown
+ my @kill_pids; # list of processes to shutdown/kill
+ my $pid;
+
+ # Start shutdown of all started masters
+ foreach my $mysqld (@{$slave}, @{$master})
+ {
+ if ( $mysqld->{'pid'} )
+ {
+ $pid= mtr_mysqladmin_start($mysqld, "shutdown", 70);
+ $admin_pids{$pid}= 1;
+
+ push(@kill_pids,{
+ pid => $mysqld->{'pid'},
+ real_pid => $mysqld->{'real_pid'},
+ pidfile => $mysqld->{'path_pid'},
+ sockfile => $mysqld->{'path_sock'},
+ port => $mysqld->{'port'},
+ errfile => $mysqld->{'path_myerr'},
+ });
+
+ $mysqld->{'pid'}= 0; # Assume we are done with it
+ }
+ }
+
+ # Wait blocking until all shutdown processes has completed
+ mtr_wait_blocking(\%admin_pids);
+
+ # Make sure that process has shutdown else try to kill them
+ mtr_check_stop_servers(\@kill_pids);
+}
+
+
+sub run_testcase_need_master_restart($)
+{
+ my ($tinfo)= @_;
+
+ # We try to find out if we are to restart the master(s)
+ my $do_restart= 0; # Assumes we don't have to
+
+ if ( $glob_use_embedded_server )
+ {
+ mtr_verbose("Never start or restart for embedded server");
+ return $do_restart;
+ }
+ elsif ( $tinfo->{'master_sh'} )
+ {
+ $do_restart= 1; # Always restart if script to run
+ mtr_verbose("Restart master: Always restart if script to run");
+ }
+ if ( $tinfo->{'force_restart'} )
+ {
+ $do_restart= 1; # Always restart if --force-restart in -opt file
+ mtr_verbose("Restart master: Restart forced with --force-restart");
+ }
+ elsif ( $master->[0]->{'running_master_options'} and
+ $master->[0]->{'running_master_options'}->{'timezone'} ne
+ $tinfo->{'timezone'})
+ {
+ $do_restart= 1;
+ mtr_verbose("Restart master: Different timezone");
+ }
+ # Check that running master was started with same options
+ # as the current test requires
+ elsif (! mtr_same_opts($master->[0]->{'start_opts'},
+ $tinfo->{'master_opt'}) )
+ {
+ $do_restart= 1;
+ mtr_verbose("Restart master: running with different options '" .
+ join(" ", @{$tinfo->{'master_opt'}}) . "' != '" .
+ join(" ", @{$master->[0]->{'start_opts'}}) . "'" );
+ }
+ elsif( ! $master->[0]->{'pid'} )
+ {
+ if ( $opt_extern )
+ {
+ $do_restart= 0;
+ mtr_verbose("No restart: using extern master");
+ }
+ else
+ {
+ $do_restart= 1;
+ mtr_verbose("Restart master: master is not started");
+ }
+ }
+ return $do_restart;
+}
+
+sub run_testcase_need_slave_restart($)
+{
+ my ($tinfo)= @_;
+
+ # We try to find out if we are to restart the slaves
+ my $do_slave_restart= 0; # Assumes we don't have to
+
+ if ( $glob_use_embedded_server )
+ {
+ mtr_verbose("Never start or restart for embedded server");
+ return $do_slave_restart;
+ }
+ elsif ( $max_slave_num == 0)
+ {
+ mtr_verbose("Skip slave restart: No testcase use slaves");
+ }
+ else
+ {
+
+ # Check if any slave is currently started
+ my $any_slave_started= 0;
+ foreach my $mysqld (@{$slave})
+ {
+ if ( $mysqld->{'pid'} )
+ {
+ $any_slave_started= 1;
+ last;
+ }
+ }
+
+ if ($any_slave_started)
+ {
+ mtr_verbose("Restart slave: Slave is started, always restart");
+ $do_slave_restart= 1;
+ }
+ elsif ( $tinfo->{'slave_num'} )
+ {
+ mtr_verbose("Restart slave: Test need slave");
+ $do_slave_restart= 1;
+ }
+ }
+
+ return $do_slave_restart;
+
+}
+
+# ----------------------------------------------------------------------
+# If not using a running servers we may need to stop and restart.
+# We restart in the case we have initiation scripts, server options
+# etc to run. But we also restart again after the test first restart
+# and test is run, to get back to normal server settings.
+#
+# To make the code a bit more clean, we actually only stop servers
+# here, and mark this to be done. Then a generic "start" part will
+# start up the needed servers again.
+# ----------------------------------------------------------------------
+
+sub run_testcase_stop_servers($$$) {
+ my ($tinfo, $do_restart, $do_slave_restart)= @_;
+ my $pid;
+ my %admin_pids; # hash of admin processes that requests shutdown
+ my @kill_pids; # list of processes to shutdown/kill
+
+ # Remember if we restarted for this test case (count restarts)
+ $tinfo->{'restarted'}= $do_restart;
+
+ if ( $do_restart )
+ {
+ delete $master->[0]->{'running_master_options'}; # Forget history
+
+ # Start shutdown of all started masters
+ foreach my $mysqld (@{$master})
+ {
+ if ( $mysqld->{'pid'} )
+ {
+ $pid= mtr_mysqladmin_start($mysqld, "shutdown", 20);
+
+ $admin_pids{$pid}= 1;
+
+ push(@kill_pids,{
+ pid => $mysqld->{'pid'},
+ real_pid => $mysqld->{'real_pid'},
+ pidfile => $mysqld->{'path_pid'},
+ sockfile => $mysqld->{'path_sock'},
+ port => $mysqld->{'port'},
+ errfile => $mysqld->{'path_myerr'},
+ });
+
+ $mysqld->{'pid'}= 0; # Assume we are done with it
+ }
+ }
+ }
+
+ if ( $do_restart || $do_slave_restart )
+ {
+
+ delete $slave->[0]->{'running_slave_options'}; # Forget history
+
+ # Start shutdown of all started slaves
+ foreach my $mysqld (@{$slave})
+ {
+ if ( $mysqld->{'pid'} )
+ {
+ $pid= mtr_mysqladmin_start($mysqld, "shutdown", 20);
+
+ $admin_pids{$pid}= 1;
+
+ push(@kill_pids,{
+ pid => $mysqld->{'pid'},
+ real_pid => $mysqld->{'real_pid'},
+ pidfile => $mysqld->{'path_pid'},
+ sockfile => $mysqld->{'path_sock'},
+ port => $mysqld->{'port'},
+ errfile => $mysqld->{'path_myerr'},
+ });
+
+
+ $mysqld->{'pid'}= 0; # Assume we are done with it
+ }
+ }
+ }
+
+ # ----------------------------------------------------------------------
+ # Shutdown has now been started and lists for the shutdown processes
+ # and the processes to be killed has been created
+ # ----------------------------------------------------------------------
+
+ # Wait blocking until all shutdown processes has completed
+ mtr_wait_blocking(\%admin_pids);
+
+
+ # Make sure that process has shutdown else try to kill them
+ mtr_check_stop_servers(\@kill_pids);
+}
+
+
+#
+# run_testcase_start_servers
+#
+# Start the servers needed by this test case
+#
+# RETURN
+# 0 OK
+# 1 Start failed
+#
+
+sub run_testcase_start_servers($) {
+ my $tinfo= shift;
+ my $tname= $tinfo->{'name'};
+
+ if ( $tinfo->{'component_id'} eq 'mysqld' )
+ {
+ if ( !$master->[0]->{'pid'} )
+ {
+ # Master mysqld is not started
+ do_before_start_master($tinfo);
+
+ mysqld_start($master->[0],$tinfo->{'master_opt'},[]);
+
+ }
+
+ # Save this test case information, so next can examine it
+ $master->[0]->{'running_master_options'}= $tinfo;
+ }
+
+ # ----------------------------------------------------------------------
+ # Start slaves - if needed
+ # ----------------------------------------------------------------------
+ if ( $tinfo->{'slave_num'} )
+ {
+ restore_slave_databases($tinfo->{'slave_num'});
+
+ do_before_start_slave($tinfo);
+
+ for ( my $idx= 0; $idx < $tinfo->{'slave_num'}; $idx++ )
+ {
+ if ( ! $slave->[$idx]->{'pid'} )
+ {
+ mysqld_start($slave->[$idx],$tinfo->{'slave_opt'},
+ $tinfo->{'slave_mi'});
+
+ }
+ }
+
+ # Save this test case information, so next can examine it
+ $slave->[0]->{'running_slave_options'}= $tinfo;
+ }
+
+ # Wait for mysqld's to start
+ foreach my $mysqld (@{$master},@{$slave})
+ {
+
+ next if !$mysqld->{'pid'};
+
+ if (mysqld_wait_started($mysqld))
+ {
+ # failed to start
+ $tinfo->{'comment'}=
+ "Failed to start $mysqld->{'type'} mysqld $mysqld->{'idx'}";
+ return 1;
+ }
+ }
+ return 0;
+}
+
+#
+# Run include/check-testcase.test
+# Before a testcase, run in record mode, save result file to var
+# After testcase, run and compare with the recorded file, they should be equal!
+#
+# RETURN VALUE
+# 0 OK
+# 1 Check failed
+#
+sub run_check_testcase ($$) {
+
+ my $mode= shift;
+ my $mysqld= shift;
+
+ my $name= "check-" . $mysqld->{'type'} . $mysqld->{'idx'};
+
+ my $args;
+ mtr_init_args(\$args);
+
+ mtr_add_arg($args, "--no-defaults");
+ mtr_add_arg($args, "--silent");
+ mtr_add_arg($args, "--tmpdir=%s", $opt_tmpdir);
+ mtr_add_arg($args, "--character-sets-dir=%s", $path_charsetsdir);
+
+ mtr_add_arg($args, "--socket=%s", $mysqld->{'path_sock'});
+ mtr_add_arg($args, "--port=%d", $mysqld->{'port'});
+ mtr_add_arg($args, "--database=test");
+ mtr_add_arg($args, "--user=%s", $opt_user);
+ mtr_add_arg($args, "--password=");
+
+ mtr_add_arg($args, "-R");
+ mtr_add_arg($args, "$opt_vardir/tmp/$name.result");
+
+ if ( $mode eq "before" )
+ {
+ mtr_add_arg($args, "--record");
+ }
+
+ my $res = mtr_run_test($exe_mysqltest,$args,
+ "include/check-testcase.test", "", "", "");
+
+ if ( $res == 1 and $mode eq "after")
+ {
+ mtr_run("diff",["-u",
+ "$opt_vardir/tmp/$name.result",
+ "$opt_vardir/tmp/$name.reject"],
+ "", "", "", "");
+ }
+ elsif ( $res )
+ {
+ mtr_error("Could not execute 'check-testcase' $mode testcase");
+ }
+ return $res;
+}
+
+##############################################################################
+#
+# Report the features that were compiled in
+#
+##############################################################################
+
+sub run_report_features () {
+ my $args;
+
+ if ( ! $glob_use_embedded_server )
+ {
+ mysqld_start($master->[0],[],[]);
+ if ( ! $master->[0]->{'pid'} )
+ {
+ mtr_error("Can't start the mysqld server");
+ }
+ mysqld_wait_started($master->[0]);
+ }
+
+ my $tinfo = {};
+ $tinfo->{'name'} = 'report features';
+ $tinfo->{'result_file'} = undef;
+ $tinfo->{'component_id'} = 'mysqld';
+ $tinfo->{'path'} = 'include/report-features.test';
+ $tinfo->{'timezone'}= "GMT-3";
+ $tinfo->{'slave_num'} = 0;
+ $tinfo->{'master_opt'} = [];
+ $tinfo->{'slave_opt'} = [];
+ $tinfo->{'slave_mi'} = [];
+ $tinfo->{'comment'} = 'report server features';
+ run_mysqltest($tinfo);
+
+ if ( ! $glob_use_embedded_server )
+ {
+ stop_all_servers();
+ }
+}
+
+
+sub run_mysqltest ($) {
+ my ($tinfo)= @_;
+ my $exe= $exe_mysqltest;
+ my $args;
+
+ mtr_init_args(\$args);
+
+ mtr_add_arg($args, "--no-defaults");
+ mtr_add_arg($args, "--silent");
+ mtr_add_arg($args, "--tmpdir=%s", $opt_tmpdir);
+ mtr_add_arg($args, "--character-sets-dir=%s", $path_charsetsdir);
+ mtr_add_arg($args, "--logdir=%s/log", $opt_vardir);
+
+ # Log line number and time for each line in .test file
+ mtr_add_arg($args, "--mark-progress")
+ if $opt_mark_progress;
+
+ # component_id == mysqld
+ {
+ mtr_add_arg($args, "--socket=%s", $master->[0]->{'path_sock'});
+ mtr_add_arg($args, "--port=%d", $master->[0]->{'port'});
+ mtr_add_arg($args, "--database=test");
+ mtr_add_arg($args, "--user=%s", $opt_user);
+ mtr_add_arg($args, "--password=");
+ }
+
+ if ( $opt_ps_protocol )
+ {
+ mtr_add_arg($args, "--ps-protocol");
+ }
+
+ if ( $opt_sp_protocol )
+ {
+ mtr_add_arg($args, "--sp-protocol");
+ }
+
+ if ( $opt_view_protocol )
+ {
+ mtr_add_arg($args, "--view-protocol");
+ }
+
+ if ( $opt_cursor_protocol )
+ {
+ mtr_add_arg($args, "--cursor-protocol");
+ }
+
+ if ( $opt_strace_client )
+ {
+ $exe= "strace"; # FIXME there are ktrace, ....
+ mtr_add_arg($args, "-o");
+ mtr_add_arg($args, "%s/log/mysqltest.strace", $opt_vardir);
+ mtr_add_arg($args, "$exe_mysqltest");
+ }
+
+ if ( $opt_timer )
+ {
+ mtr_add_arg($args, "--timer-file=%s/log/timer", $opt_vardir);
+ }
+
+ if ( $opt_compress )
+ {
+ mtr_add_arg($args, "--compress");
+ }
+
+ if ( $opt_sleep )
+ {
+ mtr_add_arg($args, "--sleep=%d", $opt_sleep);
+ }
+
+ if ( $opt_debug )
+ {
+ mtr_add_arg($args, "--debug=d:t:A,%s/log/mysqltest.trace",
+ $path_vardir_trace);
+ }
+
+ if ( $opt_ssl_supported )
+ {
+ mtr_add_arg($args, "--ssl-ca=%s/std_data/cacert.pem",
+ $glob_mysql_test_dir);
+ mtr_add_arg($args, "--ssl-cert=%s/std_data/client-cert.pem",
+ $glob_mysql_test_dir);
+ mtr_add_arg($args, "--ssl-key=%s/std_data/client-key.pem",
+ $glob_mysql_test_dir);
+ }
+
+ if ( $opt_ssl )
+ {
+ # Turn on SSL for _all_ test cases if option --ssl was used
+ mtr_add_arg($args, "--ssl");
+ }
+ elsif ( $opt_ssl_supported )
+ {
+ mtr_add_arg($args, "--skip-ssl");
+ }
+
+ foreach my $arg ( @opt_extra_mysqltest_opt )
+ {
+ mtr_add_arg($args, "%s", $arg);
+ }
+
+ # ----------------------------------------------------------------------
+ # If embedded server, we create server args to give mysqltest to pass on
+ # ----------------------------------------------------------------------
+
+ if ( $glob_use_embedded_server )
+ {
+ mysqld_arguments($args,$master->[0],$tinfo->{'master_opt'},[]);
+ }
+
+ # ----------------------------------------------------------------------
+ # export MYSQL_TEST variable containing <path>/mysqltest <args>
+ # ----------------------------------------------------------------------
+ $ENV{'MYSQL_TEST'}=
+ mtr_native_path($exe_mysqltest) . " " . join(" ", @$args);
+
+ # ----------------------------------------------------------------------
+ # Add arguments that should not go into the MYSQL_TEST env var
+ # ----------------------------------------------------------------------
+
+ if ( $opt_valgrind_mysqltest )
+ {
+ # Prefix the Valgrind options to the argument list.
+ # We do this here, since we do not want to Valgrind the nested invocations
+ # of mysqltest; that would mess up the stderr output causing test failure.
+ my @args_saved = @$args;
+ mtr_init_args(\$args);
+ valgrind_arguments($args, \$exe);
+ mtr_add_arg($args, "%s", $_) for @args_saved;
+ }
+
+ mtr_add_arg($args, "--test-file=%s", $tinfo->{'path'});
+
+ # Number of lines of resut to include in failure report
+ mtr_add_arg($args, "--tail-lines=20");
+
+ if ( defined $tinfo->{'result_file'} ) {
+ mtr_add_arg($args, "--result-file=%s", $tinfo->{'result_file'});
+ }
+
+ if ( $opt_record )
+ {
+ mtr_add_arg($args, "--record");
+ }
+
+ if ( $opt_client_gdb )
+ {
+ gdb_arguments(\$args, \$exe, "client");
+ }
+ elsif ( $opt_client_ddd )
+ {
+ ddd_arguments(\$args, \$exe, "client");
+ }
+ elsif ( $opt_client_debugger )
+ {
+ debugger_arguments(\$args, \$exe, "client");
+ }
+
+ if ( $opt_check_testcases )
+ {
+ foreach my $mysqld (@{$master}, @{$slave})
+ {
+ if ($mysqld->{'pid'})
+ {
+ run_check_testcase("before", $mysqld);
+ }
+ }
+ }
+
+ my $res = mtr_run_test($exe,$args,"","",$path_timefile,"");
+
+ if ( $opt_check_testcases )
+ {
+ foreach my $mysqld (@{$master}, @{$slave})
+ {
+ if ($mysqld->{'pid'})
+ {
+ if (run_check_testcase("after", $mysqld))
+ {
+ # Check failed, mark the test case with that info
+ $tinfo->{'check_testcase_failed'}= 1;
+ }
+ }
+ }
+ }
+
+ return $res;
+
+}
+
+
+#
+# Modify the exe and args so that program is run in gdb in xterm
+#
+sub gdb_arguments {
+ my $args= shift;
+ my $exe= shift;
+ my $type= shift;
+
+ # Write $args to gdb init file
+ my $str= join(" ", @$$args);
+ my $gdb_init_file= "$opt_tmpdir/gdbinit.$type";
+
+ # Remove the old gdbinit file
+ unlink($gdb_init_file);
+
+ if ( $type eq "client" )
+ {
+ # write init file for client
+ mtr_tofile($gdb_init_file,
+ "set args $str\n" .
+ "break main\n");
+ }
+ else
+ {
+ # write init file for mysqld
+ mtr_tofile($gdb_init_file, <<EOGDB );
+set args $str
+EOGDB
+ }
+
+ if ( $opt_manual_gdb )
+ {
+ print "\nTo start gdb for $type, type in another window:\n";
+ print "gdb -cd $glob_mysql_test_dir -x $gdb_init_file $$exe\n";
+
+ # Indicate the exe should not be started
+ $$exe= undef;
+ return;
+ }
+
+ $$args= [];
+ mtr_add_arg($$args, "-title");
+ mtr_add_arg($$args, "$type");
+ mtr_add_arg($$args, "-e");
+
+ if ( $exe_libtool )
+ {
+ mtr_add_arg($$args, $exe_libtool);
+ mtr_add_arg($$args, "--mode=execute");
+ }
+
+ mtr_add_arg($$args, "gdb");
+ mtr_add_arg($$args, "-x");
+ mtr_add_arg($$args, "$gdb_init_file");
+ mtr_add_arg($$args, "$$exe");
+
+ $$exe= "xterm";
+}
+
+
+#
+# Modify the exe and args so that program is run in ddd
+#
+sub ddd_arguments {
+ my $args= shift;
+ my $exe= shift;
+ my $type= shift;
+
+ # Write $args to ddd init file
+ my $str= join(" ", @$$args);
+ my $gdb_init_file= "$opt_tmpdir/gdbinit.$type";
+
+ # Remove the old gdbinit file
+ unlink($gdb_init_file);
+
+ if ( $type eq "client" )
+ {
+ # write init file for client
+ mtr_tofile($gdb_init_file,
+ "set args $str\n" .
+ "break main\n");
+ }
+ else
+ {
+ # write init file for mysqld
+ mtr_tofile($gdb_init_file,
+ "file $$exe\n" .
+ "set args $str\n");
+ }
+
+ if ( $opt_manual_ddd )
+ {
+ print "\nTo start ddd for $type, type in another window:\n";
+ print "ddd -cd $glob_mysql_test_dir -x $gdb_init_file $$exe\n";
+
+ # Indicate the exe should not be started
+ $$exe= undef;
+ return;
+ }
+
+ my $save_exe= $$exe;
+ $$args= [];
+ if ( $exe_libtool )
+ {
+ $$exe= $exe_libtool;
+ mtr_add_arg($$args, "--mode=execute");
+ mtr_add_arg($$args, "ddd");
+ }
+ else
+ {
+ $$exe= "ddd";
+ }
+ mtr_add_arg($$args, "--command=$gdb_init_file");
+ mtr_add_arg($$args, "$save_exe");
+}
+
+
+#
+# Modify the exe and args so that program is run in the selected debugger
+#
+sub debugger_arguments {
+ my $args= shift;
+ my $exe= shift;
+ my $debugger= $opt_debugger || $opt_client_debugger;
+
+ if ( $debugger =~ /vcexpress|vc|devenv/ )
+ {
+ # vc[express] /debugexe exe arg1 .. argn
+
+ # Add /debugexe and name of the exe before args
+ unshift(@$$args, "/debugexe");
+ unshift(@$$args, "$$exe");
+
+ # Set exe to debuggername
+ $$exe= $debugger;
+
+ }
+ elsif ( $debugger =~ /windbg/ )
+ {
+ # windbg exe arg1 .. argn
+
+ # Add name of the exe before args
+ unshift(@$$args, "$$exe");
+
+ # Set exe to debuggername
+ $$exe= $debugger;
+
+ }
+ elsif ( $debugger eq "dbx" )
+ {
+ # xterm -e dbx -r exe arg1 .. argn
+
+ unshift(@$$args, $$exe);
+ unshift(@$$args, "-r");
+ unshift(@$$args, $debugger);
+ unshift(@$$args, "-e");
+
+ $$exe= "xterm";
+
+ }
+ else
+ {
+ mtr_error("Unknown argument \"$debugger\" passed to --debugger");
+ }
+}
+
+
+#
+# Modify the exe and args so that program is run in valgrind
+#
+sub valgrind_arguments {
+ my $args= shift;
+ my $exe= shift;
+
+ if ( $opt_callgrind)
+ {
+ mtr_add_arg($args, "--tool=callgrind");
+ mtr_add_arg($args, "--base=$opt_vardir/log");
+ }
+ else
+ {
+ mtr_add_arg($args, "--tool=memcheck"); # From >= 2.1.2 needs this option
+ mtr_add_arg($args, "--leak-check=yes");
+ #mtr_add_arg($args, "--db-attach=yes");
+ mtr_add_arg($args, "--num-callers=16");
+ mtr_add_arg($args, "--suppressions=%s/valgrind.supp", $glob_mysql_test_dir)
+ if -f "$glob_mysql_test_dir/valgrind.supp";
+ }
+
+ # Add valgrind options, can be overridden by user
+ mtr_add_arg($args, '%s', $_) for (@valgrind_args);
+
+ mtr_add_arg($args, $$exe);
+
+ $$exe= $opt_valgrind_path || "valgrind";
+
+ if ($exe_libtool)
+ {
+ # Add "libtool --mode-execute" before the test to execute
+ # if running in valgrind(to avoid valgrinding bash)
+ unshift(@$args, "--mode=execute", $$exe);
+ $$exe= $exe_libtool;
+ }
+}
+
+
+##############################################################################
+#
+# Usage
+#
+##############################################################################
+
+sub usage ($) {
+ my $message= shift;
+
+ if ( $message )
+ {
+ print STDERR "$message\n";
+ }
+
+ print <<HERE;
+
+$0 [ OPTIONS ] [ TESTCASE ]
+
+Options to control what engine/variation to run
+
+ embedded-server Use the embedded server, i.e. no mysqld daemons
+ ps-protocol Use the binary protocol between client and server
+ cursor-protocol Use the cursor protocol between client and server
+ (implies --ps-protocol)
+ view-protocol Create a view to execute all non updating queries
+ sp-protocol Create a stored procedure to execute all queries
+ compress Use the compressed protocol between client and server
+ ssl Use ssl protocol between client and server
+ skip-ssl Dont start server with support for ssl connections
+ bench Run the benchmark suite
+ small-bench Run the benchmarks with --small-tests --small-tables
+ vs-config Visual Studio configuration used to create executables
+ (default: MTR_VS_CONFIG environment variable)
+
+Options to control directories to use
+ benchdir=DIR The directory where the benchmark suite is stored
+ (default: ../../mysql-bench)
+ tmpdir=DIR The directory where temporary files are stored
+ (default: ./var/tmp).
+ vardir=DIR The directory where files generated from the test run
+ is stored (default: ./var). Specifying a ramdisk or
+ tmpfs will speed up tests.
+ mem Run testsuite in "memory" using tmpfs or ramdisk
+ Attempts to find a suitable location
+ using a builtin list of standard locations
+ for tmpfs (/dev/shm)
+ The option can also be set using environment
+ variable MTR_MEM=[DIR]
+
+Options to control what test suites or cases to run
+
+ force Continue to run the suite after failure
+ do-test=PREFIX or REGEX
+ Run test cases which name are prefixed with PREFIX
+ or fulfills REGEX
+ skip-test=PREFIX or REGEX
+ Skip test cases which name are prefixed with PREFIX
+ or fulfills REGEX
+ start-from=PREFIX Run test cases starting from test prefixed with PREFIX
+ suite[s]=NAME1,..,NAMEN Collect tests in suites from the comma separated
+ list of suite names.
+ The default is: "$opt_suites_default"
+ skip-rpl Skip the replication test cases.
+ big-test Set the environment variable BIG_TEST, which can be
+ checked from test cases.
+ combination="ARG1 .. ARG2" Specify a set of "mysqld" arguments for one
+ combination.
+ skip-combination Skip any combination options and combinations files
+
+Options that specify ports
+
+ master_port=PORT Specify the port number used by the first master
+ slave_port=PORT Specify the port number used by the first slave
+ mtr-build-thread=# Specify unique collection of ports. Can also be set by
+ setting the environment variable MTR_BUILD_THREAD.
+
+Options for test case authoring
+
+ record TESTNAME (Re)genereate the result file for TESTNAME
+ check-testcases Check testcases for sideeffects
+ mark-progress Log line number and elapsed time to <testname>.progress
+
+Options that pass on options
+
+ mysqld=ARGS Specify additional arguments to "mysqld"
+
+Options to run test on running server
+
+ extern Use running server for tests
+ user=USER User for connection to extern server
+ socket=PATH Socket for connection to extern server
+
+Options for debugging the product
+
+ client-ddd Start mysqltest client in ddd
+ client-debugger=NAME Start mysqltest in the selected debugger
+ client-gdb Start mysqltest client in gdb
+ ddd Start mysqld in ddd
+ debug Dump trace output for all servers and client programs
+ debugger=NAME Start mysqld in the selected debugger
+ gdb Start the mysqld(s) in gdb
+ manual-debug Let user manually start mysqld in debugger, before
+ running test(s)
+ manual-gdb Let user manually start mysqld in gdb, before running
+ test(s)
+ manual-ddd Let user manually start mysqld in ddd, before running
+ test(s)
+ master-binary=PATH Specify the master "mysqld" to use
+ slave-binary=PATH Specify the slave "mysqld" to use
+ strace-client Create strace output for mysqltest client
+ max-save-core Limit the number of core files saved (to avoid filling
+ up disks for heavily crashing server). Defaults to
+ $opt_max_save_core, set to 0 for no limit.
+
+Options for coverage, profiling etc
+
+ gcov FIXME
+ gprof FIXME
+ valgrind Run the "mysqltest" and "mysqld" executables using
+ valgrind with default options
+ valgrind-all Synonym for --valgrind
+ valgrind-mysqltest Run the "mysqltest" and "mysql_client_test" executable
+ with valgrind
+ valgrind-mysqld Run the "mysqld" executable with valgrind
+ valgrind-options=ARGS Deprecated, use --valgrind-option
+ valgrind-option=ARGS Option to give valgrind, replaces default option(s),
+ can be specified more then once
+ valgrind-path=[EXE] Path to the valgrind executable
+ callgrind Instruct valgrind to use callgrind
+
+Misc options
+
+ comment=STR Write STR to the output
+ notimer Don't show test case execution time
+ script-debug Debug this script itself
+ verbose More verbose output
+ start-and-exit Only initialize and start the servers, using the
+ startup settings for the specified test case (if any)
+ start-dirty Only start the servers (without initialization) for
+ the specified test case (if any)
+ fast Don't try to clean up from earlier runs
+ reorder Reorder tests to get fewer server restarts
+ help Get this help text
+
+ testcase-timeout=MINUTES Max test case run time (default $default_testcase_timeout)
+ suite-timeout=MINUTES Max test suite run time (default $default_suite_timeout)
+ warnings | log-warnings Pass --log-warnings to mysqld
+
+ sleep=SECONDS Passed to mysqltest, will be used as fixed sleep time
+ client-bindir=PATH Path to the directory where client binaries are located
+ client-libdir=PATH Path to the directory where client libraries are located
+
+Deprecated options
+ with-openssl Deprecated option for ssl
+
+
+HERE
+ mtr_exit(1);
+
+}
+
+sub list_options ($) {
+ my $hash= shift;
+
+ for (keys %$hash) {
+ s/(=.*|!)$//;
+ s/\|/\n--/g;
+ print "--$_\n";
+ }
+
+ mtr_exit(1);
+}