diff options
Diffstat (limited to 'mysql-test/lib')
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/&/&/g; + $text =~ s/'/'/g; + $text =~ s/"/"/g; + $text =~ s/</</g; + $text =~ s/>/>/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); +} |