diff options
Diffstat (limited to 'mysql-test/lib')
29 files changed, 3499 insertions, 3019 deletions
diff --git a/mysql-test/lib/My/Config.pm b/mysql-test/lib/My/Config.pm index 5491e341ddc..35273f08cf7 100644 --- a/mysql-test/lib/My/Config.pm +++ b/mysql-test/lib/My/Config.pm @@ -4,6 +4,7 @@ package My::Config::Option; use strict; use warnings; +use Carp; sub new { @@ -31,7 +32,7 @@ package My::Config::Group; use strict; use warnings; - +use Carp; sub new { my ($class, $group_name)= @_; @@ -68,7 +69,7 @@ sub remove { return undef unless defined $option; # Remove from the hash - delete($self->{options_by_name}->{$option_name}) or die; + delete($self->{options_by_name}->{$option_name}) or croak; # Remove from the array @{$self->{options}}= grep { $_->name ne $option_name } @{$self->{options}}; @@ -88,6 +89,33 @@ sub name { 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 @@ -100,23 +128,37 @@ sub option { # -# Return a specific value for an option in the group +# 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); - die "No option named '$option_name' in this group" + 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; use strict; use warnings; +use Carp; use IO::File; use File::Basename; @@ -132,13 +174,13 @@ sub new { my $self= bless { groups => [] }, $class; my $F= IO::File->new($path, "<") - or die "Could not open '$path': $!"; + or croak "Could not open '$path': $!"; while ( my $line= <$F> ) { chomp($line); # [group] - if ( $line =~ /\[(.*)\]/ ) { + if ( $line =~ /^\[(.*)\]/ ) { # New group found $group_name= $1; #print "group: $group_name\n"; @@ -149,7 +191,7 @@ sub new { # Magic #! comments elsif ( $line =~ /^#\!/) { my $magic= $line; - die "Found magic comment '$magic' outside of group" + croak "Found magic comment '$magic' outside of group" unless $group_name; #print "$magic\n"; @@ -171,8 +213,13 @@ sub new { # !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" + + # 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)); @@ -182,7 +229,7 @@ sub new { elsif ( $line =~ /^([\@\w-]+)\s*$/ ) { my $option= $1; - die "Found option '$option' outside of group" + croak "Found option '$option' outside of group" unless $group_name; #print "$option\n"; @@ -194,13 +241,13 @@ sub new { my $option= $1; my $value= $2; - die "Found option '$option=$value' outside of group" + croak "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'"; + croak "Unexpected line '$line' found in '$path'"; } } @@ -231,6 +278,7 @@ sub insert { # Add the option to the group $group->insert($option, $value, $if_not_exist); } + return $group; } # @@ -240,11 +288,11 @@ sub remove { my ($self, $group_name, $option_name)= @_; my $group= $self->group($group_name); - die "group '$group_name' does not exist" + croak "group '$group_name' does not exist" unless defined($group); $group->remove($option_name) or - die "option '$option_name' does not exist"; + croak "option '$option_name' does not exist"; } @@ -267,10 +315,10 @@ sub group_exists { # sub _group_insert { my ($self, $group_name)= @_; - caller eq __PACKAGE__ or die; + caller eq __PACKAGE__ or croak; # Check that group does not already exist - die "Group already exists" if $self->group_exists($group_name); + croak "Group already exists" if $self->group_exists($group_name); my $group= My::Config::Group->new($group_name); push(@{$self->{groups}}, $group); @@ -354,11 +402,11 @@ sub value { my ($self, $group_name, $option_name)= @_; my $group= $self->group($group_name); - die "group '$group_name' does not exist" + croak "group '$group_name' does not exist" unless defined($group); my $option= $group->option($option_name); - die "option '$option_name' does not exist" + croak "option '$option_name' does not exist" unless defined($option); return $option->value(); @@ -372,7 +420,7 @@ sub exists { my ($self, $group_name, $option_name)= @_; my $group= $self->group($group_name); - die "group '$group_name' does not exist" + croak "group '$group_name' does not exist" unless defined($group); my $option= $group->option($option_name); @@ -412,11 +460,11 @@ sub stringify { # 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 + my ($self, $path)= @_; + my $F= IO::File->new($path, ">") + or croak "Could not open '$path': $!"; + print $F $self; + undef $F; # Close the file } 1; diff --git a/mysql-test/lib/My/ConfigFactory.pm b/mysql-test/lib/My/ConfigFactory.pm new file mode 100644 index 00000000000..f176ccbeab3 --- /dev/null +++ b/mysql-test/lib/My/ConfigFactory.pm @@ -0,0 +1,583 @@ +# -*- cperl -*- +package My::ConfigFactory; + +use strict; +use warnings; +use Carp; + +use My::Config; +use My::Find; + +use File::Basename; + + +# +# Rules to run first of all +# +my @pre_rules= +( +); + + +my @share_locations= ("share/mysql", "sql/share", "share"); + + +sub get_basedir { + my ($self, $group)= @_; + my $basedir= $group->if_exist('basedir') || + $self->{ARGS}->{basedir}; + return $basedir; +} + + +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_basedir($group), + \@share_locations, "english"); +} + +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)= @_; + my $hostname= $group->value('#host'); + return $self->{HOSTS}->{$hostname}++; +} + +sub fix_host { + my ($self)= @_; + # Get next host from HOSTS array + my @hosts= keys(%{$self->{HOSTS}});; + my $host_no= $self->{NEXT_HOST}++ % @hosts; + return $hosts[$host_no]; +} + +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= $group->value('tmpdir'); + return "$dir/$group_name.sock"; +} + +sub fix_log_error { + my ($self, $config, $group_name, $group)= @_; + my $dir= dirname($group->value('datadir')); + return "$dir/mysqld.err"; +} + +sub fix_log { + my ($self, $config, $group_name, $group)= @_; + my $dir= dirname($group->value('datadir')); + return "$dir/mysqld.log"; +} + +sub fix_log_slow_queries { + my ($self, $config, $group_name, $group)= @_; + my $dir= dirname($group->value('datadir')); + return "$dir/mysqld-slow.log"; +} + +sub fix_secure_file_priv { + my ($self)= @_; + my $vardir= $self->{ARGS}->{vardir}; + # By default, prevent the started mysqld to access files outside of vardir + return $vardir; +} + +sub fix_std_data { + my ($self, $config, $group_name, $group)= @_; + my $basedir= $self->get_basedir($group); + return "$basedir/mysql-test/std_data"; +} + +sub fix_ssl_ca { + my $std_data= fix_std_data(@_); + return "$std_data/cacert.pem" +} + +sub fix_ssl_server_cert { + my $std_data= fix_std_data(@_); + return "$std_data/server-cert.pem" +} + +sub fix_ssl_client_cert { + my $std_data= fix_std_data(@_); + return "$std_data/client-cert.pem" +} + +sub fix_ssl_server_key { + my $std_data= fix_std_data(@_); + return "$std_data/server-key.pem" +} + +sub fix_ssl_client_key { + my $std_data= fix_std_data(@_); + return "$std_data/client-key.pem" +} + + +# +# 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' => sub { return shift->{ARGS}->{tmpdir}; } }, + { 'character-sets-dir' => \&fix_charset_dir }, + { 'language' => \&fix_language }, + { 'datadir' => \&fix_datadir }, + { 'pid-file' => \&fix_pidfile }, + { '#host' => \&fix_host }, + { 'port' => \&fix_port }, + { 'socket' => \&fix_socket }, + { 'log-error' => \&fix_log_error }, + { 'log' => \&fix_log }, + { 'log-slow-queries' => \&fix_log_slow_queries }, + { '#user' => sub { return shift->{ARGS}->{user} || ""; } }, + { '#password' => sub { return shift->{ARGS}->{password} || ""; } }, + { 'server-id' => \&fix_server_id, }, + # By default, prevent the started mysqld to access files outside of vardir + { 'secure-file-priv' => sub { return shift->{ARGS}->{vardir}; } }, + { 'loose-ssl-ca' => \&fix_ssl_ca }, + { 'loose-ssl-cert' => \&fix_ssl_server_cert }, + { 'loose-ssl-key' => \&fix_ssl_server_key }, + ); + + +sub fix_ndb_mgmd_port { + my ($self, $config, $group_name, $group)= @_; + my $hostname= $group->value('HostName'); + return $self->{HOSTS}->{$hostname}++; +} + + +sub fix_cluster_dir { + my ($self, $config, $group_name, $group)= @_; + my $vardir= $self->{ARGS}->{vardir}; + my (undef, $process_type, $idx, $suffix)= split(/\./, $group_name); + return "$vardir/mysql_cluster.$suffix/$process_type.$idx"; +} + + +sub fix_cluster_backup_dir { + my ($self, $config, $group_name, $group)= @_; + my $vardir= $self->{ARGS}->{vardir}; + my (undef, $process_type, $idx, $suffix)= split(/\./, $group_name); + return "$vardir/mysql_cluster.$suffix/"; +} + + +# +# Rules to run for each ndb_mgmd in the config +# - will be run in order listed here +# +my @ndb_mgmd_rules= +( + { 'PortNumber' => \&fix_ndb_mgmd_port }, + { 'DataDir' => \&fix_cluster_dir }, +); + + +# +# Rules to run for each ndbd in the config +# - will be run in order listed here +# +my @ndbd_rules= +( + { 'HostName' => \&fix_host }, + { 'DataDir' => \&fix_cluster_dir }, + { 'BackupDataDir' => \&fix_cluster_backup_dir }, +); + + +# +# Rules to run for each cluster_config section +# - will be run in order listed here +# +my @cluster_config_rules= +( + { 'ndb_mgmd' => \&fix_host }, + { 'ndbd' => \&fix_host }, + { 'mysqld' => \&fix_host }, + { 'ndbapi' => \&fix_host }, +); + + +# +# Rules to run for [client] section +# - will be run in order listed here +# +my @client_rules= +( +); + + +# +# Rules to run for [mysqltest] section +# - will be run in order listed here +# +my @mysqltest_rules= +( + { 'loose-ssl-ca' => \&fix_ssl_ca }, + { 'loose-ssl-cert' => \&fix_ssl_client_cert }, + { 'loose-ssl-key' => \&fix_ssl_client_key }, +); + + +# +# Rules to run for [mysqlbinlog] section +# - will be run in order listed here +# +my @mysqlbinlog_rules= +( + { 'character-sets-dir' => \&fix_charset_dir }, +); + + +# +# Generate a [client.<suffix>] group pointing 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'"; + } + $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()) + } + +} + + +sub resolve_at_variable { + my ($self, $config, $group, $option)= @_; + + # Split the options value on last . + my @parts= split(/\./, $option->value()); + my $option_name= pop(@parts); + my $group_name= join('.', @parts); + + $group_name =~ s/^\@//; # Remove at + + my $from_group= $config->group($group_name) + or croak "There is no group named '$group_name' that ", + "can be used to resolve '$option_name'"; + + my $from= $from_group->value($option_name); + $config->insert($group->name(), $option->name(), $from) +} + + +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() =~ /^\@/); + } + } +} + +sub post_fix_mysql_cluster_section { + my ($self, $config)= @_; + + # Add a [mysl_cluster.<suffix>] section for each + # defined [cluster_config.<suffix>] section + foreach my $group ( $config->like('cluster_config.') ) + { + my @urls; + # Generate ndb_connectstring for this cluster + foreach my $ndb_mgmd ( $config->like('cluster_config.ndb_mgmd.')) { + if ($ndb_mgmd->suffix() eq $group->suffix()) { + my $host= $ndb_mgmd->value('HostName'); + my $port= $ndb_mgmd->value('PortNumber'); + push(@urls, "$host:$port"); + } + } + croak "Could not generate valid ndb_connectstring for '$group'" + unless @urls > 0; + my $ndb_connectstring= join(";", @urls); + + # Add ndb_connectstring to [mysql_cluster.<suffix>] + $config->insert('mysql_cluster'.$group->suffix(), + 'ndb_connectstring', $ndb_connectstring); + + # Add ndb_connectstring to each mysqld connected to this + # cluster + foreach my $mysqld ( $config->like('cluster_config.mysqld.')) { + if ($mysqld->suffix() eq $group->suffix()) { + my $after= $mysqld->after('cluster_config.mysqld'); + $config->insert("mysqld$after", + 'ndb_connectstring', $ndb_connectstring); + } + } + } +} + +# +# Rules to run last of all +# +my @post_rules= +( + \&post_check_client_groups, + \&post_fix_mysql_cluster_section, + \&post_fix_resolve_at_variables, +); + + +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 run_generate_sections_from_cluster_config { + my ($self, $config)= @_; + + my @options= ('ndb_mgmd', 'ndbd', + 'mysqld', 'ndbapi'); + + foreach my $group ( $config->like('cluster_config.') ) { + + # Keep track of current index per process type + my %idxes; + map { $idxes{$_}= 1; } @options; + + foreach my $option_name ( @options ) { + my $value= $group->value($option_name); + my @hosts= split(/,/, $value, -1); # -1 => return also empty strings + + # Add at least one host + push(@hosts, undef) unless scalar(@hosts); + + # Assign hosts unless already fixed + @hosts= map { $self->fix_host() unless $_; } @hosts; + + # Write the hosts value back + $group->insert($option_name, join(",", @hosts)); + + # Generate sections for each host + foreach my $host ( @hosts ){ + my $idx= $idxes{$option_name}++; + + my $suffix= $group->suffix(); + # Generate a section for ndb_mgmd to read + $config->insert("cluster_config.$option_name.$idx$suffix", + "HostName", $host); + + if ($option_name eq 'mysqld'){ + my $datadir= + $self->fix_cluster_dir($config, + "cluster_config.mysqld.$idx$suffix", + $group); + $config->insert("mysqld.$idx$suffix", + 'datadir', "$datadir/data"); + } + } + } + } +} + + +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}; + } + + # Fill in hosts/port hash + my $hosts= {}; + my $baseport= $args->{baseport}; + $args->{hosts}= [ 'localhost' ] unless exists($args->{hosts}); + foreach my $host ( @{$args->{hosts}} ) { + $hosts->{$host}= $baseport; + } + + # Open the config template + my $config= My::Config->new($args->{'template_path'}); + my $extra_template_path= $args->{'extra_template_path'}; + if ($extra_template_path){ + $config->append(My::Config->new($extra_template_path)); + } + my $self= bless { + CONFIG => $config, + ARGS => $args, + HOSTS => $hosts, + NEXT_HOST => 0, + SERVER_ID => 1, + }, $class; + + + { + # Run pre rules + foreach my $rule ( @pre_rules ) { + &$rule($self, $config); + } + } + + + $self->run_section_rules($config, + 'cluster_config.', + @cluster_config_rules); + $self->run_generate_sections_from_cluster_config($config); + + $self->run_section_rules($config, + 'cluster_config.ndb_mgmd.', + @ndb_mgmd_rules); + $self->run_section_rules($config, + 'cluster_config.ndbd', + @ndbd_rules); + + $self->run_section_rules($config, + 'mysqld.', + @mysqld_rules); + + # [mysqlbinlog] need additional settings + $self->run_rules_for_group($config, + $config->insert('mysqlbinlog'), + @mysqlbinlog_rules); + + # Additional reuls required for [client] + $self->run_rules_for_group($config, + $config->insert('client'), + @client_rules); + + + # Additional reuls 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/File/Path.pm b/mysql-test/lib/My/File/Path.pm new file mode 100644 index 00000000000..b6056bf470f --- /dev/null +++ b/mysql-test/lib/My/File/Path.pm @@ -0,0 +1,83 @@ +# -*- cperl -*- +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 /; + + +use File::Find; +use File::Path; +use File::Copy; +use Carp; + +no warnings 'redefine'; + +sub rmtree { + my ($dir)= @_; + + # + # chmod all files to 0777 before calling rmtree + # + find( { + no_chdir => 1, + wanted => sub { + chmod(0777, $_) + or warn("couldn't chmod(0777, $_): $!"); + } + }, + $dir + ); + + + # Call rmtree from File::Path + goto &File::Path::rmtree; +}; + + +sub mkpath { + goto &File::Path::mkpath; +}; + + +sub copytree { + my ($from_dir, $to_dir) = @_; + + die "Usage: copytree(<fromdir>, <todir>" unless @_ == 2; + + 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; + } + copy("$from_dir/$_", "$to_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 00000000000..8b996ce45a4 --- /dev/null +++ b/mysql-test/lib/My/Find.pm @@ -0,0 +1,171 @@ +# -*- cperl -*- +# Copyright (C) 2004-2006 MySQL AB +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; version 2 of the License. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + + +package My::Find; + +# +# Utility functions to find files in a MySQL source or bindist +# + +use strict; + +use base qw(Exporter); +our @EXPORT= qw(my_find_bin my_find_dir); + +our $vs_config_dir; + +my $is_win= ($^O eq "MSWin32" or $^O eq "Win32"); + +# +# 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"); +# +# NOTE: The function honours MTR_VS_CONFIG environment variable +# +# +sub my_find_bin { + my ($base, $paths, $names)= @_; + die "usage: my_find_bin(<base>, <paths>, <names>)" + unless @_ == 3; + + # ------------------------------------------------------- + # Find and return the first executable + # ------------------------------------------------------- + foreach my $path (my_find_paths($base, $paths, $names)) { + return $path if ( -x $path or ($is_win and -f $path) ); + } + find_error($base, $paths, $names); +} + + +# +# my_find_dir - find the first existing directory in one of +# the given paths +# +# 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)= @_; + die "usage: my_find_dir(<base>, <paths>[, <dirs>])" + unless (@_ == 3 or @_ == 2); + + # ------------------------------------------------------- + # Find and return the first directory + # ------------------------------------------------------- + foreach my $path (my_find_paths($base, $paths, $dirs)) { + return $path if ( -d $path ); + } + find_error($base, $paths, $dirs); +} + + +sub my_find_paths { + my ($base, $paths, $names)= @_; + + # 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= $vs_config_dir || $ENV{MTR_VS_CONFIG} || $ENV{MTR_BUILD_DIR}; + push(@extra_dirs, $build_dir) if defined $build_dir; + + # ------------------------------------------------------- + # Windows specific + # ------------------------------------------------------- + if ($is_win) { + # Append .exe to names, if name does not already have extension + map { $_.=".exe" unless /\.(.*)+$/ } @names; + + # 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"; + + # ------------------------------------------------------- + # Return the list of paths + # ------------------------------------------------------- + return @paths; +} + + +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); + + die "Could not find ", + join(", ", @names), " in ", + join(", ", my_find_paths($base, $paths, $names)); +} + +1; diff --git a/mysql-test/lib/My/SafeProcess.pm b/mysql-test/lib/My/SafeProcess.pm new file mode 100644 index 00000000000..7e1f699ee25 --- /dev/null +++ b/mysql-test/lib/My/SafeProcess.pm @@ -0,0 +1,502 @@ +# -*- cperl -*- +# Copyright (C) 2004-2006 MySQL AB +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; version 2 of the License. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +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 wich 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 POSIX qw(WNOHANG); + +use My::SafeProcess::Base; +use base 'My::SafeProcess::Base'; + +use My::Find; + +my %running; + +BEGIN { + if ($^O eq "MSWin32") { + eval 'sub IS_WIN32PERL () { 1 }'; + } + else { + eval 'sub IS_WIN32PERL () { 0 }'; + } + if ($^O eq "cygwin") { + eval 'sub IS_CYGWIN () { 1 }'; + # Make sure cygpath works + if ((system("cygpath > /dev/null 2>&1") >> 8) != 1){ + die "Could not execute 'cygpath': $!"; + } + eval 'sub fixpath { + my ($path)= @_; + return unless defined $path; + $path= `cygpath -w $path`; + chomp $path; + return $path; + }'; + } + else { + eval 'sub IS_CYGWIN () { 0 }'; + } +} + +# Find the safe process binary or script +my $safe_path= $^X; # Path to perl binary +my $safe_script; +my $safe_kill; +if (IS_WIN32PERL or IS_CYGWIN){ + # Use my_safe_process.exe + $safe_path= my_find_bin(("extra","bin"), "my_safe_process.exe"); + die "Could not find my_safe_process.exe" unless $safe_path; + + # Use my_safe_kill.exe + $safe_path= my_find_bin(("extra","bin"), "my_safe_kill"); + die "Could not find my_safe_kill.exe" unless $safe_kill; +} +else { + # Use safe_process.pl + $safe_script= "lib/My/SafeProcess/safe_process.pl"; + $safe_script= "../$safe_script" unless -f $safe_script; + die "Could not find safe_process.pl" unless -f $safe_script; +} + + +sub new { + my $class= shift; + + my %opts= + ( + verbose => 0, + @_ + ); + + 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 $verbose = delete($opts{'verbose'}); + my $host = delete($opts{'host'}); + my $shutdown = delete($opts{'shutdown'}); + + if (defined $host) { + $safe_script= "lib/My/SafeProcess/safe_process_cpcd.pl"; + } + + if (IS_CYGWIN){ + # safe_procss is a windows program and need + # windows paths + $path= fixpath($path); + $input= fixpath($input); + $output= fixpath($output); + $error= fixpath($error); + } + + my @safe_args; + push(@safe_args, $safe_script) if defined $safe_script; + + push(@safe_args, "--verbose") if $verbose > 0; + + # Point the safe_process at the right parent if running on cygwin + push(@safe_args, "--parent-pid=".Cygwin::pid_to_winpid($$)) if IS_CYGWIN; + + push(@safe_args, "--"); + push(@safe_args, $path); # The program safe_process should execute + push(@safe_args, @$$args); + + print "### safe_path: ", $safe_path, " ", join(" ", @safe_args), "\n" + if $verbose > 1; + + my ($pid, $winpid)= 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 => $winpid, + SAFE_NAME => $name, + SAFE_SHUTDOWN => $shutdown, + }, $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(); +} + +# +# Start a process that returns after "duration" seconds +# or when it's parent process does not exist anymore +# +sub timer { + my $class= shift; + my $duration= shift or die "duration required"; + my $parent_pid= $$; + + my $pid= My::SafeProcess::Base::_safe_fork(); + if ($pid){ + # Parent + my $proc= bless + ({ + SAFE_PID => $pid, + SAFE_NAME => "timer", + }, $class); + + # Put the new process in list of running + $running{$pid}= $proc; + return $proc; + } + + # Child, install signal handlers and sleep for "duration" + $SIG{INT}= 'DEFAULT'; + + $SIG{TERM}= sub { + #print STDERR "timer $$: woken up, exiting!\n"; + exit(0); + }; + + $0= "safe_timer($duration)"; + my $count_down= $duration; + while($count_down--){ + + # Check that parent is still alive + if (kill(0, $parent_pid) == 0){ + #print STDERR "timer $$: parent gone, exiting!\n"; + exit(0); + } + + sleep(1); + } + print STDERR "timer $$: expired after $duration seconds\n"; + exit(0); +} + + +# +# 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= @_; + + return if (@processes == 0); + + #print "shutdown: @processes\n"; + + # Call shutdown function if process has one, else + # use kill + foreach my $proc (@processes){ + my $shutdown= $proc->{SAFE_SHUTDOWN}; + if ($shutdown_timeout > 0 and defined $shutdown){ + $shutdown->(); + } + else { + $proc->start_kill(); + } + } + + my @kill_processes= (); + + # Wait for shutdown_timeout for processes to exit + foreach my $proc (@processes){ + 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; + } + + # 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(); + } + return; +} + + +# +# Tell the process to die as fast as possible +# +sub start_kill { + my ($self)= @_; + die "usage: \$safe_proc->start_kill()" unless (@_ == 1 and ref $self); + #print "start_kill $self\n"; + + if (defined $safe_kill and $self->{SAFE_WINPID}){ + # Use my_safe_kill to tell my_safe_process + # it's time to kill it's child and return + my $pid= $self->{SAFE_WINPID}; + my $ret= system($safe_kill, $pid); + #print STDERR "start_kill, safe_killed $pid, ret: $ret\n"; + } else { + my $pid= $self->{SAFE_PID}; + die "Can't kill not started process" unless defined $pid; + my $ret= kill(15, $pid); + #print STDERR "start_kill, sent signal 15 to $pid, ret: $ret\n"; + } + return 1; +} + + +# +# Kill the process as fast as possible +# and wait for it to return +# +sub kill { + my ($self)= @_; + die "usage: \$safe_proc->kill()" unless (@_ == 1 and ref $self); + + $self->start_kill(); + $self->wait_one(); + return 1; +} + + +sub _collect { + my ($self)= @_; + + #print "_collect\n"; + $self->{EXIT_STATUS}= $?; + + # 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)= @_; + die "usage: \$safe_proc->wait_one([timeout])" unless ref $self; + + #print "wait_one $self, $timeout\n"; + + if ( ! defined($self->{SAFE_PID}) ) { + # No pid => not running + return 0; + } + + if ( defined $self->{EXIT_STATUS} ) { + # 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; + } + + my $retpid; + eval + { + # alarm should break the wait + local $SIG{ALRM}= sub { die "waitpid timeout"; }; + + alarm($timeout) if $use_alarm; + + $retpid= waitpid($pid, $blocking ? 0 : &WNOHANG); + + alarm(0) if $use_alarm; + }; + + if ($@) + { + die "Got unexpected: $@" if ($@ !~ /waitpid timeout/); + if (!defined $retpid) { + # Got timeout + return 1; + } + # Got pid _and_ alarm, continue + } + + if ( $retpid == 0 ) { + # 0 => still running + return 1; + } + + if ( not $blocking and $retpid == -1 ) { + # still running + return 1; + } + + warn "wait_one: expected pid $pid but got $retpid" + unless( $retpid == $pid ); + + $self->_collect(); + return 0; +} + + +# +# Wait for any process to exit +# +# Returns a reference to the SafeProcess that +# exited or undefined +# +sub wait_any { + my $ret_pid; + 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); + + # Special processig of return code + # since negative pids are valid + if ($ret_pid == 0 or $ret_pid == -1) { + print STDERR "wait_any, got invalid pid: $ret_pid\n"; + return undef; + } + } + 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; + } + } + + # Look it up in "running" table + my $proc= $running{$ret_pid}; + unless (defined $proc){ + print STDERR "Could not find pid in running list\n"; + print STDERR "running: ". join(", ", keys(%running)). "\n"; + return undef; + } + $proc->_collect; + return $proc; +} + +# +# 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.= "]"; +} + + +1; diff --git a/mysql-test/lib/My/SafeProcess/Base.pm b/mysql-test/lib/My/SafeProcess/Base.pm new file mode 100644 index 00000000000..2f3cf9d037a --- /dev/null +++ b/mysql-test/lib/My/SafeProcess/Base.pm @@ -0,0 +1,236 @@ +# -*- cperl -*- +# Copyright (C) 2004-2006 MySQL AB +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; version 2 of the License. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +# This is a library file used by the Perl version of mysql-test-run, +# and is part of the translation of the Bourne shell script with the +# same name. + +use strict; + +package My::SafeProcess::Base; + +# +# Utility functions for Process management +# + +use Carp; +use IO::Pipe; + +use base qw(Exporter); +our @EXPORT= qw(create_process); + + +sub winpid { + my ($pid)= @_; + + return undef unless $^O eq "cygwin"; + + # The child get a new winpid when the exec takes + # place, wait for that to happen + my $winpid; + my $delay= 0; + do + { + # Yield to the child + select(undef, undef, undef, $delay); + # Increase the delay slightly for each loop + $delay += 0.000001; + + $winpid= Cygwin::pid_to_winpid($pid); + + } until ($winpid != $pid); + + return $winpid; +} + + + +# +# safe_fork +# Retry a couple of times if fork returns EAGAIN +# +sub _safe_fork { + my $retries= 5; + 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; + }; +} + + +# +# 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"){ + + #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 wantarray ? ($pid, $pid) : $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 wantarray ? ($pid, winpid($pid)) : $pid; + } + + $SIG{INT}= '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 and !open(STDOUT, $open_mode, $output) ) { + 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: $!"); + } + } + elsif ( ! open(STDERR, $open_mode, $error) ) { + 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/safe_kill_win.cc b/mysql-test/lib/My/SafeProcess/safe_kill_win.cc new file mode 100755 index 00000000000..8049f626c93 --- /dev/null +++ b/mysql-test/lib/My/SafeProcess/safe_kill_win.cc @@ -0,0 +1,56 @@ +/* Copyright (C) 2004 MySQL AB + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; version 2 of the License. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA */ + + +/* + Utility program used to signal a safe_process it's time to shutdown + + Usage: + safe_kill <pid> +*/ + +#include <windows.h> +#include <stdio.h> + +int main(int argc, const char** argv ) +{ + DWORD pid= -1; + HANDLE shutdown_event; + char safe_process_name[32]= {0}; + + if (argc != 2) { + fprintf(stderr, "safe_kill <pid>\n"); + exit(2); + } + pid= atoi(argv[1]); + + _snprintf(safe_process_name, sizeof(safe_process_name), "safe_process[%d]", pid); + + /* Open the event to signal */ + if ((shutdown_event= + OpenEvent(EVENT_MODIFY_STATE, FALSE, safe_process_name)) == NULL){ + fprintf(stderr, "Failed to open shutdown_event\n"); + exit(1); + } + + if(SetEvent(shutdown_event) == 0) { + fprintf(stderr, "Failed to signal shutdown_event\n"); + CloseHandle(shutdown_event); + exit(1); + } + CloseHandle(shutdown_event); + exit(0); +} + diff --git a/mysql-test/lib/My/SafeProcess/safe_process.pl b/mysql-test/lib/My/SafeProcess/safe_process.pl new file mode 100644 index 00000000000..707f78d36bd --- /dev/null +++ b/mysql-test/lib/My/SafeProcess/safe_process.pl @@ -0,0 +1,141 @@ +#!/usr/bin/perl +# -*- cperl -*- + +use strict; +use warnings; + +use Time::localtime; +use lib 'lib'; +use My::SafeProcess::Base; +use POSIX qw(WNOHANG); + +########################################################################### +# Util functions +########################################################################### + +# +#Print message to stderr +# +my $verbose= 0; +sub message { + if ($verbose > 0){ + my $tm= localtime(); + my $timestamp= sprintf("%02d%02d%02d %2d:%02d:%02d", + $tm->year % 100, $tm->mon+1, $tm->mday, + $tm->hour, $tm->min, $tm->sec); + print STDERR $timestamp, " monitor[$$]: ", @_, "\n"; + } +} + + +########################################################################### +# Main program +########################################################################### + +my $terminated= 0; + +# Protect against being killed in the middle +# of child creation, just set the terminated flag +# to make sure the child will be killed off +# when program is ready to do that +$SIG{TERM}= sub { message("!Got signal @_"); $terminated= 1; }; +$SIG{INT}= sub { message("!Got signal @_"); $terminated= 1; }; + +my $parent_pid= getppid(); + +use Getopt::Long; +GetOptions( + 'verbose' => \$verbose, + ) or die "GetOptions failed"; +shift(@ARGV) if defined($ARGV[0]) and $ARGV[0] eq "--"; +my $path= shift(@ARGV); # Executable + +die "usage:\n" . + " safe_process.pl [opts] -- <path> [<args> [...<args_n>]]" + unless defined $path; + + +message("started"); +#message("path: '$path'"); +message("parent: $parent_pid"); + +# Start process to monitor +my $child_pid= + create_process( + path => $path, + args => \@ARGV, + setpgrp => 1, + ); +message("Started child $child_pid"); + +eval { + sub handle_signal { + $terminated= 1; + message("Got signal @_"); + + # Ignore all signals + foreach my $name (keys %SIG){ + $SIG{$name}= 'IGNORE'; + } + + die "signaled\n"; + }; + local $SIG{TERM}= \&handle_signal; + local $SIG{INT}= \&handle_signal; + local $SIG{CHLD}= sub { + message("Got signal @_"); + kill(9, -$child_pid); + my $ret= waitpid($child_pid, 0); + if ($? & 127){ + exit(65); # Killed by signal + } + exit($? >> 8); + }; + + # Monitoring loop + while(!$terminated) { + + # Check if parent is still alive + if (kill(0, $parent_pid) < 1){ + message("Parent is not alive anymore"); + last; + } + + # Wait for child to terminate but wakeup every + # second to also check that parent is still alive + my $ret_pid; + $ret_pid= waitpid($child_pid, &WNOHANG); + if ($ret_pid == $child_pid) { + # Process has exited, collect return status + my $ret_code= $? >> 8; + message("Child exit: $ret_code"); + # Exit with exit status of the child + exit ($ret_code); + } + sleep(1); + } +}; +if ( $@ ) { + # The monitoring loop should have been + # broken by handle_signal + warn "Unexpected: $@" unless ( $@ =~ /signaled/ ); +} + +# Use negative pid in order to kill the whole +# process group +# +my $ret= kill(9, -$child_pid); +message("Killed child: $child_pid, ret: $ret"); +if ($ret > 0) { + message("Killed child: $child_pid"); + # Wait blocking for the child to return + my $ret_pid= waitpid($child_pid, 0); + if ($ret_pid != $child_pid){ + message("unexpected pid $ret_pid returned from waitpid($child_pid)"); + } +} + +message("DONE!"); +exit (1); + + 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 100755 index 00000000000..1547070ce20 --- /dev/null +++ b/mysql-test/lib/My/SafeProcess/safe_process_win.cc @@ -0,0 +1,312 @@ +/* Copyright (C) 2004 MySQL AB + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; version 2 of the License. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 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. +*/ + +/* Requires Windows 2000 or higher */ +#define _WIN32_WINNT 0x0500 + +#include <windows.h> +#include <stdio.h> +#include <tlhelp32.h> +#include <signal.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, ...) +{ + 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= GetLastError()) + fprintf(stderr, "error: %d, %s\n", last_err, strerror(last_err)); + exit(1); +} + + +DWORD get_parent_pid(DWORD pid) +{ + HANDLE snapshot; + DWORD parent_pid= -1; + 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 == -1) + 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}; + + sprintf(safe_process_name, "safe_process[%d]", 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++) { + to+= _snprintf(to, child_args + sizeof(child_args) - to, "%s ", argv[j]); + } + break; + } else { + if ( strcmp(arg, "--verbose") == 0 ) + verbose++; + else if ( strncmp(arg, "--parent-pid", 10) == 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 + 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. + */ + jeli.BasicLimitInformation.LimitFlags = JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE; + if (SetInformationJobObject(job_handle, JobObjectExtendedLimitInformation, + &jeli, sizeof(jeli)) == 0) + message("SetInformationJobObject failed, continue anyway..."); + +#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 + */ + if (CreateProcess(NULL, (LPSTR)child_args, + NULL, + NULL, + TRUE, /* inherit handles */ + CREATE_SUSPENDED, + NULL, + NULL, + &si, + &process_info) == 0) + die("CreateProcess failed"); + + if (AssignProcessToJobObject(job_handle, process_info.hProcess) == 0) + { + TerminateProcess(process_info.hProcess, 200); + die("AssignProcessToJobObject 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); + + if (wait_res != WAIT_OBJECT_0 + CHILD) + { + /* 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 */ + } + + for (int i= 0; i < NUM_HANDLES; i++) + CloseHandle(wait_handles[i]); + + exit(child_exit_code); +} + diff --git a/mysql-test/lib/mtr_cases.pl b/mysql-test/lib/mtr_cases.pm index a4ef9aad897..4d6885f5495 100644 --- a/mysql-test/lib/mtr_cases.pl +++ b/mysql-test/lib/mtr_cases.pm @@ -1,15 +1,15 @@ # -*- cperl -*- # Copyright (C) 2005-2006 MySQL AB -# +# # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; version 2 of the License. -# +# # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. -# +# # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA @@ -18,59 +18,86 @@ # and is part of the translation of the Bourne shell script with the # same name. -use File::Basename; -use IO::File(); +package mtr_cases; use strict; -use My::Config; +use base qw(Exporter); +our @EXPORT= qw(collect_option collect_test_cases); + +# Options used for the collect phase +our $start_from; +our $print_testcases; +our $skip_rpl; +our $do_test; +our $skip_test; +our $opt_skip_combination; +our $binlog_format;; +our $enable_disabled; +our $default_storage_engine; +our $opt_with_ndbcluster_only; +our $defaults_file; +our $defaults_extra_file; + +sub collect_option { + my ($opt, $value)= @_; + + # Convert - to _ in option name + $opt =~ s/-/_/; + no strict 'refs'; + ${$opt}= $value; +} -sub collect_test_cases ($); -sub collect_one_suite ($); -sub collect_one_test_case ($$$$$$$$$); +use File::Basename; +use IO::File(); +use My::Config; -sub mtr_options_from_test_file($$); +require "mtr_settings.pl"; +require "mtr_report.pl"; +require "mtr_match.pl"; +require "mtr_misc.pl"; -my $do_test; -my $skip_test; +# Precompiled regex's for tests to do or skip +my $do_test_reg; +my $skip_test_reg; sub init_pattern { my ($from, $what)= @_; - if ( $from =~ /[a-z0-9]/ ) { - # Does not contain any regex, make the pattern match + 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_verbose("$what='$from'"); } - else { - # Check that pattern is a valid regex - eval { "" =~/$from/; 1 } or - mtr_error("Invalid regex '$from' passed to $what\nPerl says: $@"); - } + # 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 we are to run +# Collect information about test cases to be run # ############################################################################## sub collect_test_cases ($) { - $do_test= init_pattern($::opt_do_test, "--do-test"); - $skip_test= init_pattern($::opt_skip_test, "--skip-test"); - my $suites= shift; # Semicolon separated list of test suites - my $cases = []; # Array of hash + 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"); foreach my $suite (split(",", $suites)) { push(@$cases, collect_one_suite($suite)); } - if ( @::opt_cases ) { + # A list of tests was specified on the command line # Check that the tests specified was found # in at least one suite foreach my $test_name_spec ( @::opt_cases ) @@ -99,14 +126,13 @@ sub collect_test_cases ($) { # 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. + # first, then a sub-criterion, then sub-sub-criterion, etc. 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 + # Look for tests that must be run in a defined order - that is + # defined by test having the same name except for the ending digit # Put variables into hash my $test_name= $tinfo->{'name'}; @@ -156,25 +182,23 @@ sub collect_test_cases ($) { $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"); - } - } + # For debugging the sort-order + # foreach my $tinfo (@$cases) + # { + # print("$sort_criteria{$tinfo->{'name'}} -> \t$tinfo->{'name'}\n"); + # } + + } + + if (defined $print_testcases){ + print_testcases(@$cases); + exit(1); } return $cases; } -# Valid extensions and their corresonding component id -my %exts = ( 'test' => 'mysqld', - 'imtest' => 'im' - ); - # Returns (suitename, testname, extension) sub split_testname { @@ -190,7 +214,7 @@ sub split_testname { # Either testname.test or suite.testname given # Ex. main.alias or alias.test - if (defined $exts{$parts[1]}) + if ($parts[1] eq "test") { return (undef , $parts[0], $parts[1]); } @@ -212,7 +236,7 @@ sub split_testname { sub collect_one_suite($) { my $suite= shift; # Test suite name - my @cases; # Array of hash + my @cases; # Array of hash mtr_verbose("Collecting: $suite"); @@ -222,11 +246,39 @@ sub collect_one_suite($) $suitedir= mtr_path_exists("$suitedir/suite/$suite", "$suitedir/$suite"); mtr_verbose("suitedir: $suitedir"); + + } my $testdir= "$suitedir/t"; my $resdir= "$suitedir/r"; + # Check if t/ exists + if (-d $testdir){ + # t/ exists + + if ( -d $resdir ) + { + # r/exists + } + else + { + # No r/, use t/ as result dir + $resdir= $testdir; + } + + } + else { + # No t/ dir => there can' be any r/ dir + mtr_error("Can't have r/ dir without t/") if -d $resdir; + + # No t/ or r/ => use suitedir + $resdir= $testdir= $suitedir; + } + + mtr_verbose("testdir: $testdir"); + mtr_verbose("resdir: $resdir"); + # ---------------------------------------------------------------------- # Build a hash of disabled testcases for this suite # ---------------------------------------------------------------------- @@ -249,7 +301,7 @@ sub collect_one_suite($) my $suite_opts= []; if ( -f $suite_opt_file ) { - $suite_opts= mtr_get_opts_from_file($suite_opt_file); + $suite_opts= opts_from_file($suite_opt_file); } if ( @::opt_cases ) @@ -267,7 +319,6 @@ sub collect_one_suite($) # 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"; @@ -281,28 +332,26 @@ sub collect_one_suite($) next; } - $component_id= $exts{$extension}; } else { - # No extension was specified - my ($ext, $component); - while (($ext, $component)= each %exts) { - my $full_name= "$testdir/$tname.$ext"; + # No extension was specified, use default + $extension= "test"; + my $full_name= "$testdir/$tname.$extension"; - if ( ! -f $full_name ) { - next; - } - $component_id= $component; - $extension= $ext; - } # Test not found here, could exist in other suite - next unless $component_id; + next if ( ! -f $full_name ); } - collect_one_test_case($testdir,$resdir,$suite,$tname, - "$tname.$extension",\@cases,\%disabled, - $component_id,$suite_opts); + push(@cases, + collect_one_test_case($suitedir, + $testdir, + $resdir, + $suite, + $tname, + "$tname.$extension", + \%disabled, + $suite_opts)); } } else @@ -311,33 +360,26 @@ sub collect_one_suite($) foreach my $elem ( sort readdir(TESTDIR) ) { - my $component_id= undef; - my $tname= undef; + my $tname= mtr_match_extension($elem, 'test'); - if ($tname= mtr_match_extension($elem, 'test')) - { - $component_id = 'mysqld'; - } - elsif ($tname= mtr_match_extension($elem, 'imtest')) - { - $component_id = 'im'; - } - else - { - next; - } + next unless defined $tname; # 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); + next if ($do_test_reg and not $tname =~ /$do_test_reg/o); + + push(@cases, + collect_one_test_case($suitedir, + $testdir, + $resdir, + $suite, + $tname, + $elem, + \%disabled, + $suite_opts)); } closedir TESTDIR; } - # Return empty list if no testcases found return if (@cases == 0); @@ -345,7 +387,7 @@ sub collect_one_suite($) # Read combinations for this suite and build testcases x combinations # if any combinations exists # ---------------------------------------------------------------------- - if ( ! $::opt_skip_combination ) + if ( ! $opt_skip_combination ) { my @combinations; my $combination_file= "$suitedir/combinations"; @@ -366,7 +408,6 @@ sub collect_one_suite($) # Read combinations file in my.cnf format mtr_verbose("Read combinations file"); my $config= My::Config->new($combination_file); - foreach my $group ($config->groups()) { my $comb= {}; $comb->{name}= $group->name(); @@ -414,7 +455,6 @@ sub collect_one_suite($) #print_testcases(@cases); } } - optimize_cases(\@cases); #print_testcases(@cases); @@ -422,6 +462,7 @@ sub collect_one_suite($) } + # # Loop through all test cases # - optimize which test to run by skipping unnecessary ones @@ -435,169 +476,79 @@ sub optimize_cases { # Skip processing if already marked as skipped next if $tinfo->{skip}; - # Replication test needs an adjustment of binlog format - if (mtr_match_prefix($tinfo->{'name'}, "rpl")) + # ======================================================= + # If a special binlog format was selected with + # --mysqld=--binlog-format=x, skip all test that does not + # support it + # ======================================================= + if (defined $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= $test_binlog_format || - mtr_match_prefix($opt, "--binlog-format="); - } - # print $tinfo->{name}." uses ".$test_binlog_format."\n"; - - # ======================================================= - # If a special binlog format was selected with - # --mysqld=--binlog-format=x, skip all test with different - # binlog-format - # ======================================================= - if (defined $::used_binlog_format and - $test_binlog_format and - $::used_binlog_format ne $test_binlog_format) - { - $tinfo->{'skip'}= 1; - $tinfo->{'comment'}= "Requires --binlog-format='$test_binlog_format'"; - next; - } - # ======================================================= - # Check that testcase supports the designated binlog-format + # Fixed --binlog-format=x specified on command line # ======================================================= - if ($test_binlog_format and defined $tinfo->{'sup_binlog_formats'} ) + if ( defined $tinfo->{'binlog_formats'} ) { + # The test supports different binlog formats + # check if the selected one is ok my $supported= - grep { $_ eq $test_binlog_format } @{$tinfo->{'sup_binlog_formats'}}; + grep { $_ eq $binlog_format } @{$tinfo->{'binlog_formats'}}; if ( !$supported ) { $tinfo->{'skip'}= 1; $tinfo->{'comment'}= - "Doesn't support --binlog-format='$test_binlog_format'"; - next; + "Doesn't support --binlog-format='$binlog_format'"; } } - + } + else + { # ======================================================= - # Use dynamic switching of binlog-format if mtr started - # w/o --mysqld=--binlog-format=xxx and combinations. + # Use dynamic switching of binlog format # ======================================================= - if (!defined $tinfo->{'combination'} and - !defined $::used_binlog_format) - { - $test_binlog_format= $tinfo->{'sup_binlog_formats'}->[0]; + + # 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; } - # Save binlog format for dynamic switching - $tinfo->{binlog_format}= $test_binlog_format; + if (defined $test_binlog_format) + { + if ( 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; + } + } + + # Save binlog format for dynamic switching + $tinfo->{binlog_format_switch}= $test_binlog_format; + } } } } -############################################################################## # -# Collect information about a single test case +# Read options from the given opt file and append them as an array +# to $tinfo->{$opt_name} # -############################################################################## - - -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); - - # ---------------------------------------------------------------------- - # 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; - } +sub process_opts_file { + my ($tinfo, $opt_file, $opt_name)= @_; - 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_verbose($opt); - push(@{$tinfo->{'master_opt'}}, $opt); - push(@{$tinfo->{'slave_opt'}}, $opt); - } - - # Add master opts - if ( -f $master_opt_file ) + $tinfo->{$opt_name}= []; + if ( -f $opt_file ) { + my $opts= opts_from_file($opt_file); - my $master_opt= mtr_get_opts_from_file($master_opt_file); - - foreach my $opt ( @$master_opt ) + foreach my $opt ( @$opts ) { my $value; @@ -612,13 +563,6 @@ sub collect_one_test_case($$$$$$$$$) { 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 ) { @@ -628,6 +572,14 @@ sub collect_one_test_case($$$$$$$$$) { next; } + $value= mtr_match_prefix($opt, "--config-file-template="); + if ( defined $value) + { + # Specifies the configuration file to use for this test + $tinfo->{'template_path'}= dirname($tinfo->{path})."/$value"; + next; + } + # If we set default time zone, remove the one we have $value= mtr_match_prefix($opt, "--default-time-zone="); if ( defined $value ) @@ -648,36 +600,124 @@ sub collect_one_test_case($$$$$$$$$) { } # Ok, this was a real option, add it - push(@{$tinfo->{'master_opt'}}, $opt); + push(@{$tinfo->{$opt_name}}, $opt); } } +} + +############################################################################## +# +# Collect information about a single test case +# +############################################################################## + +sub collect_one_test_case { + my $suitedir= shift; + my $testdir= shift; + my $resdir= shift; + my $suitename= shift; + my $tname= shift; + my $filename= shift; + my $disabled= shift; + my $suite_opts= shift; - # Add slave opts - if ( -f $slave_opt_file ) + #print "collect_one_test_case\n"; + #print " suitedir: $suitedir\n"; + #print " testdir: $testdir\n"; + #print " resdir: $resdir\n"; + #print " suitename: $suitename\n"; + #print " tname: $tname\n"; + #print " filename: $filename\n"; + + # ---------------------------------------------------------------------- + # Skip some tests silently + # ---------------------------------------------------------------------- + if ( $start_from and $tname lt $start_from ) { - my $slave_opt= mtr_get_opts_from_file($slave_opt_file); + return; + } - 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); + # ---------------------------------------------------------------------- + # Set defaults + # ---------------------------------------------------------------------- + my $tinfo= {}; + $tinfo->{'name'}= basename($suitename) . ".$tname"; + $tinfo->{'path'}= "$testdir/$filename"; + + # TODO allow nonexistsing result file + # in that case .test must issue "exit" otherwise test should fail by default + $tinfo->{'result_file'}= "$resdir/$tname.result"; + + # ---------------------------------------------------------------------- + # Skip some tests but include in list, just mark them as skipped + # ---------------------------------------------------------------------- + if ( $skip_test_reg and $tname =~ /$skip_test_reg/o ) + { + $tinfo->{'skip'}= 1; + return $tinfo; + } + + # ---------------------------------------------------------------------- + # Check for disabled tests + # ---------------------------------------------------------------------- + my $marked_as_disabled= 0; + if ( $disabled->{$tname} ) + { + # Test was marked as disabled in suites disabled.def file + $marked_as_disabled= 1; + $tinfo->{'comment'}= $disabled->{$tname}; + } + + my $disabled_file= "$testdir/$tname.disabled"; + if ( -f $disabled_file ) + { + $marked_as_disabled= 1; + $tinfo->{'comment'}= mtr_fromfile($disabled_file); } - if ( -f $slave_mi_file ) + if ( $marked_as_disabled ) { - $tinfo->{'slave_mi'}= mtr_get_opts_from_file($slave_mi_file); + if ( $enable_disabled ) + { + # User has selected to run all disabled tests + mtr_report(" - $tinfo->{name} wil be run although it's been disabled\n", + " due to '$tinfo->{comment}'"); + } + else + { + $tinfo->{'skip'}= 1; + $tinfo->{'disable'}= 1; # Sub type of 'skip' + return $tinfo; + } } + # ---------------------------------------------------------------------- + # Append suite extra options to both master and slave + # ---------------------------------------------------------------------- + push(@{$tinfo->{'master_opt'}}, @$suite_opts); + push(@{$tinfo->{'slave_opt'}}, @$suite_opts); + + # ---------------------------------------------------------------------- + # Add master opts, extra options only for master + # ---------------------------------------------------------------------- + process_opts_file($tinfo, "$testdir/$tname-master.opt", 'master_opt'); + + # ---------------------------------------------------------------------- + # Add slave opts, list of extra option only for slave + # ---------------------------------------------------------------------- + process_opts_file($tinfo, "$testdir/$tname-slave.opt", 'slave_opt'); + + # ---------------------------------------------------------------------- + # master sh + # ---------------------------------------------------------------------- + my $master_sh= "$testdir/$tname-master.sh"; if ( -f $master_sh ) { - if ( $::glob_win32_perl ) + if ( $main::is_win32_perl ) { $tinfo->{'skip'}= 1; $tinfo->{'comment'}= "No tests with sh scripts on Windows"; - return; + return $tinfo; } else { @@ -685,13 +725,17 @@ sub collect_one_test_case($$$$$$$$$) { } } + # ---------------------------------------------------------------------- + # slave sh + # ---------------------------------------------------------------------- + my $slave_sh= "$testdir/$tname-slave.sh"; if ( -f $slave_sh ) { - if ( $::glob_win32_perl ) + if ( $main::is_win32_perl ) { $tinfo->{'skip'}= 1; $tinfo->{'comment'}= "No tests with sh scripts on Windows"; - return; + return $tinfo; } else { @@ -699,202 +743,178 @@ sub collect_one_test_case($$$$$$$$$) { } } - if ( -f $im_opt_file ) - { - $tinfo->{'im_opts'} = mtr_get_opts_from_file($im_opt_file); - } - else + # ---------------------------------------------------------------------- + # <tname>.slave-mi + # ---------------------------------------------------------------------- + mtr_error("$tname: slave-mi not supported anymore") + if ( -f "$testdir/$tname.slave-mi"); + + + tags_from_test_file($tinfo,"$testdir/${tname}.test"); + + if ( defined $default_storage_engine ) { - $tinfo->{'im_opts'} = []; + # Different default engine is used + # tag test to require that engine + $tinfo->{'ndb_test'}= 1 + if ( $default_storage_engine =~ /^ndb/i ); + + $tinfo->{'innodb_test'}= 1 + if ( $default_storage_engine =~ /^innodb/i ); + } - # FIXME why this late? - my $marked_as_disabled= 0; - if ( $disabled->{$tname} ) + if ( $tinfo->{'big_test'} and ! $::opt_big_test ) { - $marked_as_disabled= 1; - $tinfo->{'comment'}= $disabled->{$tname}; + $tinfo->{'skip'}= 1; + $tinfo->{'comment'}= "Test need 'big-test' option"; + return $tinfo } - if ( -f $disabled_file ) + if ( $tinfo->{'ndb_extra'} and ! $::opt_ndb_extra_test ) { - $marked_as_disabled= 1; - $tinfo->{'comment'}= mtr_fromfile($disabled_file); + $tinfo->{'skip'}= 1; + $tinfo->{'comment'}= "Test need 'ndb_extra' option"; + return $tinfo } - # 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 ( $tinfo->{'need_debug'} && ! $::debug_compiled_binaries ) { - if ( $::opt_enable_disabled ) - { - $tinfo->{'dont_skip_though_disabled'}= 1; - } - else - { - $tinfo->{'skip'}= 1; - $tinfo->{'disable'}= 1; # Sub type of 'skip' - return; - } + $tinfo->{'skip'}= 1; + $tinfo->{'comment'}= "Test need debug binaries"; + return $tinfo } - if ( $component_id eq 'im' ) + if ( $tinfo->{'ndb_test'} ) { - if ( $::glob_use_embedded_server ) + # This is a NDB test + if ( ! $::glob_ndbcluster_supported ) { + # Ndb is not supported, skip it $tinfo->{'skip'}= 1; - $tinfo->{'comment'}= "No IM with embedded server"; - return; + $tinfo->{'comment'}= "No ndbcluster support"; + return $tinfo; } - elsif ( $::opt_ps_protocol ) + elsif ( $::opt_skip_ndbcluster ) { + # All ndb test's should be skipped $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; + $tinfo->{'comment'}= "No ndbcluster tests(--skip-ndbcluster)"; + return $tinfo; } } 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->{'ndb_test'}= 1 - if ( $::used_default_engine =~ /^ndb/i ); - - $tinfo->{'innodb_test'}= 1 - if ( $::used_default_engine =~ /^innodb/i ); - } - - if ( $tinfo->{'big_test'} and ! $::opt_big_test ) + # This is not a ndb test + if ( $opt_with_ndbcluster_only ) { + # Only the ndb test should be run, all other should be skipped $tinfo->{'skip'}= 1; - $tinfo->{'comment'}= "Test need 'big-test' option"; - return; + $tinfo->{'comment'}= "Only ndbcluster tests"; + return $tinfo; } + } - if ( $tinfo->{'ndb_extra'} and ! $::opt_ndb_extra_test ) + if ( $tinfo->{'innodb_test'} ) + { + # This is a test that need innodb + if ( $::mysqld_variables{'innodb'} ne "TRUE" ) { + # innodb is not supported, skip it $tinfo->{'skip'}= 1; - $tinfo->{'comment'}= "Test need 'ndb_extra' option"; - return; + $tinfo->{'comment'}= "No innodb support"; + return $tinfo; } + } + else + { + push(@{$tinfo->{'master_opt'}}, "--loose-skip-innodb"); + push(@{$tinfo->{'slave_opt'}}, "--loose-skip-innodb"); + } - if ( $tinfo->{'require_manager'} ) + if ( $tinfo->{'need_binlog'} ) + { + if (grep(/^--skip-log-bin/, @::opt_extra_mysqld_opt) ) { $tinfo->{'skip'}= 1; - $tinfo->{'comment'}= "Test need the _old_ manager(to be removed)"; - return; + $tinfo->{'comment'}= "Test need binlog"; + return $tinfo; } + } + else + { + # Test does not need binlog, add --skip-binlog to + # the options used when starting + push(@{$tinfo->{'master_opt'}}, "--loose-skip-log-bin"); + push(@{$tinfo->{'slave_opt'}}, "--loose-skip-log-bin"); + } - if ( $tinfo->{'need_debug'} && ! $::debug_compiled_binaries ) + if ( $tinfo->{'rpl_test'} ) + { + if ( $skip_rpl ) { $tinfo->{'skip'}= 1; - $tinfo->{'comment'}= "Test need debug binaries"; - return; - } - - if ( $tinfo->{'ndb_test'} ) - { - # This is a NDB test - if ( ! $::glob_ndbcluster_supported ) - { - # Ndb is not supported, skip it - $tinfo->{'skip'}= 1; - $tinfo->{'comment'}= "No ndbcluster support"; - return; - } - elsif ( $::opt_skip_ndbcluster ) - { - # All ndb test's should be skipped - $tinfo->{'skip'}= 1; - $tinfo->{'comment'}= "No ndbcluster tests(--skip-ndbcluster)"; - return; - } - # Ndb tests run with two mysqld masters - $tinfo->{'master_num'}= 2; - } - else - { - # This is not a ndb test - if ( $::opt_with_ndbcluster_only ) - { - # Only the ndb test should be run, all other should be skipped - $tinfo->{'skip'}= 1; - $tinfo->{'comment'}= "Only ndbcluster tests(--with-ndbcluster-only)"; - return; - } - } - - if ( $tinfo->{'innodb_test'} ) - { - # This is a test that need innodb - if ( $::mysqld_variables{'innodb'} ne "TRUE" ) - { - # innodb is not supported, skip it - $tinfo->{'skip'}= 1; - $tinfo->{'comment'}= "No innodb support"; - return; - } + $tinfo->{'comment'}= "No replication tests(--skip-rpl)"; + return $tinfo; } + } - if ( $tinfo->{'need_binlog'} ) - { - if (grep(/^--skip-log-bin/, @::opt_extra_mysqld_opt) ) - { - $tinfo->{'skip'}= 1; - $tinfo->{'comment'}= "Test need binlog"; - return; - } - } - else + # ---------------------------------------------------------------------- + # Find config file to use if not already selected in <testname>.opt file + # ---------------------------------------------------------------------- + if (defined $defaults_file) { + # Using same config file for all tests + $tinfo->{template_path}= $defaults_file; + } + elsif (! $tinfo->{template_path} ) + { + my $config= "$suitedir/my.cnf"; + if (! -f $config ) { - 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"); - } + # Suite has no config, use default.cnf + $config= "include/default_my.cnf"; } + $tinfo->{template_path}= $config; + } + # Set extra config file to use + if (defined $defaults_extra_file) { + $tinfo->{extra_template_path}= $defaults_extra_file; } + + return $tinfo; } # List of tags in the .test files that if found should set # the specified value in "tinfo" -our @tags= +my @tags= ( - ["include/have_innodb.inc", "innodb_test", 1], - ["include/have_binlog_format_row.inc", "sup_binlog_formats", ["row"]], - ["include/have_log_bin.inc", "need_binlog", 1], - ["include/have_binlog_format_statement.inc", - "sup_binlog_formats", ["statement"]], - ["include/have_binlog_format_mixed.inc", "sup_binlog_formats", ["mixed"]], + ["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", - "sup_binlog_formats", ["mixed","row"]], + "binlog_formats", ["mixed", "row"]], ["include/have_binlog_format_mixed_or_statement.inc", - "sup_binlog_formats", ["mixed","statement"]], + "binlog_formats", ["mixed", "statement"]], ["include/have_binlog_format_row_or_statement.inc", - "sup_binlog_formats", ["row","statement"]], + "binlog_formats", ["row", "statement"]], + + ["include/have_log_bin.inc", "need_binlog", 1], + + ["include/have_innodb.inc", "innodb_test", 1], ["include/big_test.inc", "big_test", 1], ["include/have_debug.inc", "need_debug", 1], ["include/have_ndb.inc", "ndb_test", 1], ["include/have_multi_ndb.inc", "ndb_test", 1], ["include/have_ndb_extra.inc", "ndb_extra", 1], - ["require_manager", "require_manager", 1], + ["include/master-slave.inc", "rpl_test", 1], + ["include/ndb_master-slave.inc", "rpl_test", 1], + ["include/federated.inc", "federated_test", 1], ); -sub mtr_options_from_test_file($$) { + +sub tags_from_test_file { my $tinfo= shift; my $file= shift; #mtr_verbose("$file"); @@ -911,8 +931,8 @@ sub mtr_options_from_test_file($$) { { if ( index($line, $tag->[0]) >= 0 ) { - # Tag matched, assign value to "tinfo" - $tinfo->{"$tag->[1]"}= $tag->[2]; + # Tag matched, assign value to "tinfo" + $tinfo->{"$tag->[1]"}= $tag->[2]; } } @@ -930,12 +950,83 @@ sub mtr_options_from_test_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); + tags_from_test_file($tinfo, $sourced_file); } } + } } +sub unspace { + my $string= shift; + my $quote= shift; + $string =~ s/[ \t]/\x11/g; + return "$quote$string$quote"; +} + + + +sub envsubst { + my $string= shift; + + if ( ! defined $ENV{$string} ) + { + mtr_error("opt file referense \$$string that is unknown"); + } + + return $ENV{$string}; +} + + +sub opts_from_file ($) { + my $file= shift; + + open(FILE,"<",$file) or mtr_error("can't open file \"$file\": $!"); + my @args; + while ( <FILE> ) + { + chomp; + + # --set-variable=init_connect=set @a='a\\0c' + s/^\s+//; # Remove leading space + s/\s+$//; # Remove ending space + + # This is strange, but we need to fill whitespace inside + # quotes with something, to remove later. We do this to + # be able to split on space. Else, we have trouble with + # options like + # + # --someopt="--insideopt1 --insideopt2" + # + # But still with this, we are not 100% sure it is right, + # we need a shell to do it right. + + 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; + + # Expand environment variables + $arg =~ s/\$\{(\w+)\}/envsubst($1)/ge; + $arg =~ s/\$(\w+)/envsubst($1)/ge; + + # Do not pass empty string since my_getopt is not capable to handle it. + if (length($arg)) { + push(@args, $arg); + } + } + } + close FILE; + return \@args; +} sub print_testcases { my (@cases)= @_; @@ -944,9 +1035,9 @@ sub print_testcases { foreach my $test (@cases){ print "[", $test->{name}, "]", "\n"; while ((my ($key, $value)) = each(%$test)) { - print " ", $key, "="; + print " ", $key, "= "; if (ref $value eq "ARRAY") { - print join(", ", @$value); + print "[", join(", ", @$value), "]"; } else { print $value; } diff --git a/mysql-test/lib/mtr_diff.pl b/mysql-test/lib/mtr_diff.pl deleted file mode 100644 index 26e556de5e8..00000000000 --- a/mysql-test/lib/mtr_diff.pl +++ /dev/null @@ -1,297 +0,0 @@ -# -*- cperl -*- -# Copyright (C) 2005 MySQL AB -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; version 2 of the License. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA - -# This is a library file used by the Perl version of mysql-test-run, -# and is part of the translation of the Bourne shell script with the -# same name. - -#use Data::Dumper; -use strict; - -# $Data::Dumper::Indent= 1; - -sub mtr_diff($$); - -############################################################################## -# -# This is a simplified unified diff, with some special handling -# of unsorted result sets -# -############################################################################## - -# FIXME replace die with mtr_error - -#require "mtr_report.pl"; -#mtr_diff("a.txt","b.txt"); - -sub mtr_diff ($$) { - my $file1 = shift; - my $file2 = shift; - - # ---------------------------------------------------------------------- - # We read in all of the files at once - # ---------------------------------------------------------------------- - - unless ( open(FILE1, $file1) ) - { - mtr_warning("can't open \"$file1\": $!"); - return; - } - - unless ( open(FILE2, $file2) ) - { - mtr_warning("can't open \"$file2\": $!"); - return; - } - - my $lines1= collect_lines(<FILE1>); - my $lines2= collect_lines(<FILE2>); - close FILE1; - close FILE2; - -# print Dumper($lines1); -# print Dumper($lines2); - - # ---------------------------------------------------------------------- - # We compare line by line, but don't shift off elements until we know - # what to do. This way we use the "restart" method, do simple change - # and restart by entering the diff loop from the beginning again. - # ---------------------------------------------------------------------- - - my @context; - my @info; # Collect information, and output later - my $lno1= 1; - my $lno2= 1; - - while ( @$lines1 or @$lines2 ) - { - unless ( @$lines1 ) - { - push(@info, map {['+',$lno1,$lno2++,$_]} @$lines2); - last; - } - unless ( @$lines2 ) - { - push(@info, map {['-',$lno1++,$lno2,$_]} @$lines1); - last; - } - - # ---------------------------------------------------------------------- - # We know both have lines - # ---------------------------------------------------------------------- - - if ( $lines1->[0] eq $lines2->[0] ) - { - # Simple case, first line match and all is well - push(@info, ['',$lno1++,$lno2++,$lines1->[0]]); - shift @$lines1; - shift @$lines2; - next; - } - - # ---------------------------------------------------------------------- - # Now, we know they differ - # ---------------------------------------------------------------------- - - # How far in the other one, is there a match? - - my $idx2= find_next_match($lines1->[0], $lines2); - my $idx1= find_next_match($lines2->[0], $lines1); - - # Here we could test "if ( !defined $idx2 or !defined $idx1 )" and - # use a more complicated diff algorithm in the case both contains - # each others lines, just dislocated. But for this application, there - # should be no need. - - if ( !defined $idx2 ) - { - push(@info, ['-',$lno1++,$lno2,$lines1->[0]]); - shift @$lines1; - } - else - { - push(@info, ['+',$lno1,$lno2++,$lines2->[0]]); - shift @$lines2; - } - } - - # ---------------------------------------------------------------------- - # Try to output nicely - # ---------------------------------------------------------------------- - -# print Dumper(\@info); - - # We divide into "chunks" to output - # We want at least three lines of context - - my @chunks; - my @chunk; - my $state= 'pre'; # 'pre', 'in' and 'post' difference - my $post_count= 0; - - foreach my $info ( @info ) - { - if ( $info->[0] eq '' and $state eq 'pre' ) - { - # Collect no more than three lines of context before diff - push(@chunk, $info); - shift(@chunk) if @chunk > 3; - next; - } - - if ( $info->[0] =~ /(\+|\-)/ and $state =~ /(pre|in)/ ) - { - # Start/continue collecting diff - $state= 'in'; - push(@chunk, $info); - next; - } - - if ( $info->[0] eq '' and $state eq 'in' ) - { - # Stop collecting diff, and collect context after diff - $state= 'post'; - $post_count= 1; - push(@chunk, $info); - next; - } - - if ( $info->[0] eq '' and $state eq 'post' and $post_count < 6 ) - { - # We might find a new diff sequence soon, continue to collect - # non diffs but five up on 6. - $post_count++; - push(@chunk, $info); - next; - } - - if ( $info->[0] eq '' and $state eq 'post' ) - { - # We put an end to this, giving three non diff lines to - # the old chunk, and three to the new one. - my @left= splice(@chunk, -3, 3); - push(@chunks, [@chunk]); - $state= 'pre'; - $post_count= 0; - @chunk= @left; - next; - } - - if ( $info->[0] =~ /(\+|\-)/ and $state eq 'post' ) - { - # We didn't split, continue collect diff - $state= 'in'; - push(@chunk, $info); - next; - } - - } - - if ( $post_count > 3 ) - { - $post_count -= 3; - splice(@chunk, -$post_count, $post_count); - } - push(@chunks, [@chunk]) if @chunk and $state ne 'pre'; - - foreach my $chunk ( @chunks ) - { - my $from_file_start= $chunk->[0]->[1]; - my $to_file_start= $chunk->[0]->[2]; - my $from_file_offset= $chunk->[$#$chunk]->[1] - $from_file_start; - my $to_file_offset= $chunk->[$#$chunk]->[2] - $to_file_start; - print "\@\@ -$from_file_start,$from_file_offset ", - "+$to_file_start,$to_file_offset \@\@\n"; - - foreach my $info ( @$chunk ) - { - if ( $info->[0] eq '' ) - { - print " $info->[3]\n"; - } - elsif ( $info->[0] eq '-' ) - { - print "- $info->[3]\n"; - } - elsif ( $info->[0] eq '+' ) - { - print "+ $info->[3]\n"; - } - } - } - -# print Dumper(\@chunks); - -} - - -############################################################################## -# Find if the string is found in the array, return the index if found, -# if not found, return "undef" -############################################################################## - -sub find_next_match { - my $line= shift; - my $lines= shift; - - for ( my $idx= 0; $idx < @$lines; $idx++ ) - { - return $idx if $lines->[$idx] eq $line; - } - - return undef; # No match found -} - - -############################################################################## -# Just read the lines, but handle "sets" of lines that are unordered -############################################################################## - -sub collect_lines { - - my @recordset; - my @lines; - - while (@_) - { - my $line= shift @_; - chomp($line); - - if ( $line =~ /^\Q%unordered%\E\t/ ) - { - push(@recordset, $line); - } - elsif ( @recordset ) - { - push(@lines, sort @recordset); - @recordset= (); # Clear it - } - else - { - push(@lines, $line); - } - } - - if ( @recordset ) - { - push(@lines, sort @recordset); - @recordset= (); # Clear it - } - - return \@lines; -} - -1; diff --git a/mysql-test/lib/mtr_im.pl b/mysql-test/lib/mtr_im.pl deleted file mode 100644 index c8e332498d7..00000000000 --- a/mysql-test/lib/mtr_im.pl +++ /dev/null @@ -1,775 +0,0 @@ -# -*- cperl -*- -# Copyright (C) 2006 MySQL AB -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; version 2 of the License. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA - -# This is a library file used by the Perl version of mysql-test-run, -# and is part of the translation of the Bourne shell script with the -# same name. - -use strict; - -# 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/mtr_io.pl b/mysql-test/lib/mtr_io.pl index aa671c0f4f7..6712c19b829 100644 --- a/mysql-test/lib/mtr_io.pl +++ b/mysql-test/lib/mtr_io.pl @@ -20,135 +20,14 @@ 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_printfile($); -############################################################################## -# -# -# -############################################################################## - -sub mtr_get_pid_from_file ($) { - my $pid_file_path= shift; - my $TOTAL_ATTEMPTS= 30; - my $timeout= 1; - - # We should read from the file until we get correct pid. As it is - # stated in BUG#21884, pid file can be empty at some moment. So, we should - # read it until we get valid data. - - for (my $cur_attempt= 1; $cur_attempt <= $TOTAL_ATTEMPTS; ++$cur_attempt) - { - mtr_debug("Reading pid file '$pid_file_path' " . - "($cur_attempt of $TOTAL_ATTEMPTS)..."); - - open(FILE, '<', $pid_file_path) - or mtr_error("can't open file \"$pid_file_path\": $!"); - - # Read pid number from file - my $pid= <FILE>; - chomp $pid; - close FILE; - - return $pid if $pid=~ /^(\d+)/; - - mtr_debug("Pid file '$pid_file_path' does not yet contain pid number.\n" . - "Sleeping $timeout second(s) more..."); - - sleep($timeout); - } - - mtr_error("Pid file '$pid_file_path' is corrupted. " . - "Can not retrieve PID in " . - ($timeout * $TOTAL_ATTEMPTS) . " seconds."); -} - -sub mtr_get_opts_from_file ($) { - my $file= shift; - - open(FILE,"<",$file) or mtr_error("can't open file \"$file\": $!"); - my @args; - while ( <FILE> ) - { - chomp; - - # --set-variable=init_connect=set @a='a\\0c' - s/^\s+//; # Remove leading space - s/\s+$//; # Remove ending space - - # This is strange, but we need to fill whitespace inside - # quotes with something, to remove later. We do this to - # be able to split on space. Else, we have trouble with - # options like - # - # --someopt="--insideopt1 --insideopt2" - # - # But still with this, we are not 100% sure it is right, - # we need a shell to do it right. - -# print STDERR "\n"; -# print STDERR "AAA: $_\n"; - - s/\'([^\'\"]*)\'/unspace($1,"\x0a")/ge; - s/\"([^\'\"]*)\"/unspace($1,"\x0b")/ge; - s/\'([^\'\"]*)\'/unspace($1,"\x0a")/ge; - s/\"([^\'\"]*)\"/unspace($1,"\x0b")/ge; - -# print STDERR "BBB: $_\n"; - -# foreach my $arg (/(--?\w.*?)(?=\s+--?\w|$)/) - - # FIXME ENV vars should be expanded!!!! - - foreach my $arg (split(/[ \t]+/)) - { - $arg =~ tr/\x11\x0a\x0b/ \'\"/; # Put back real chars - # The outermost quotes has to go - $arg =~ s/^([^\'\"]*)\'(.*)\'([^\'\"]*)$/$1$2$3/ - or $arg =~ s/^([^\'\"]*)\"(.*)\"([^\'\"]*)$/$1$2$3/; - $arg =~ s/\\\\/\\/g; - - $arg =~ s/\$\{(\w+)\}/envsubst($1)/ge; - $arg =~ s/\$(\w+)/envsubst($1)/ge; - -# print STDERR "ARG: $arg\n"; - # Do not pass empty string since my_getopt is not capable to handle it. - if (length($arg)) - { - push(@args, $arg) - } - } - } - close FILE; - return \@args; -} - -sub envsubst { - my $string= shift; - - if ( ! defined $ENV{$string} ) - { - mtr_error("opt file referense \$$string that is unknown"); - } - - return $ENV{$string}; -} - -sub unspace { - my $string= shift; - my $quote= shift; - $string =~ s/[ \t]/\x11/g; - return "$quote$string$quote"; -} - # Read a whole file, stripping leading and trailing whitespace. sub mtr_fromfile ($) { my $file= shift; @@ -161,19 +40,6 @@ sub mtr_fromfile ($) { 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; @@ -183,6 +49,7 @@ sub mtr_tofile ($@) { close FILE; } + sub mtr_tonewfile ($@) { my $file= shift; @@ -191,6 +58,7 @@ sub mtr_tonewfile ($@) { close FILE; } + sub mtr_appendfile_to_file ($$) { my $from_file= shift; my $to_file= shift; @@ -203,6 +71,7 @@ sub mtr_appendfile_to_file ($$) { close TOFILE; } + # Read a whole file verbatim. sub mtr_grab_file($) { my $file= shift; @@ -215,4 +84,15 @@ sub mtr_grab_file($) { } +# Print the file to STDOUT +sub mtr_printfile($) { + my $file= shift; + open(FILE, '<', $file) + or warn $!; + print while(<FILE>); + close FILE; + return; +} + + 1; diff --git a/mysql-test/lib/mtr_misc.pl b/mysql-test/lib/mtr_misc.pl index 0173e8b8572..95f5bf584f0 100644 --- a/mysql-test/lib/mtr_misc.pl +++ b/mysql-test/lib/mtr_misc.pl @@ -19,18 +19,16 @@ # same name. use strict; -use File::Find; sub mtr_native_path($); 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_copy_dir($$); -sub mtr_rmtree($); sub mtr_same_opts($$); sub mtr_cmp_opts($$); @@ -56,7 +54,11 @@ sub mtr_native_path($) } -# FIXME move to own lib +############################################################################## +# +# Args +# +############################################################################## sub mtr_init_args ($) { my $args = shift; @@ -68,9 +70,18 @@ sub mtr_add_arg ($$@) { my $format= shift; my @fargs = @_; + # Quote args if args contain space + $format= "\"$format\"" + if ($::glob_win32 and grep(/\s/, @fargs)); + push(@$args, sprintf($format, @fargs)); } +sub mtr_args2str($@) { + my $exe= shift or die; + return join(" ", mtr_native_path($exe), @_); +} + ############################################################################## # @@ -141,7 +152,6 @@ sub mtr_exe_maybe_exists (@) { my @path= @_; map {$_.= ".exe"} @path if $::glob_win32; - map {$_.= ".nlm"} @path if $::glob_netware; foreach my $path ( @path ) { if($::glob_win32) @@ -179,79 +189,6 @@ sub mtr_exe_exists (@) { } -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; @@ -280,33 +217,41 @@ sub mtr_cmp_opts ($$) { return 0; # They are the same } + +sub mtr_milli_sleep { + die "usage: mtr_milli_sleep(milliseconds)" unless @_ == 1; + my ($millis)= @_; + + select(undef, undef, undef, ($millis/1000)); +} + # # 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) + my $found; + my @result; + foreach my $e1 (@$l1) + { + $found= undef; + foreach my $e2 (@$l2) { - $f= 1 unless ($e1 ne $e2); + $found= 1 unless ($e1 ne $e2); } - push(@$l, $e1) unless (defined $f); + push(@result, $e1) unless (defined $found); } - foreach my $e2 (@$l2) + foreach my $e2 (@$l2) { - $f= undef; - foreach my $e1 (@$l1) + $found= undef; + foreach my $e1 (@$l1) { - $f= 1 unless ($e1 ne $e2); + $found= 1 unless ($e1 ne $e2); } - push(@$l, $e2) unless (defined $f); + push(@result, $e2) unless (defined $found); } - return $l; + return @result; } 1; diff --git a/mysql-test/lib/mtr_process.pl b/mysql-test/lib/mtr_process.pl index 8fd900330da..a99119a199d 100644 --- a/mysql-test/lib/mtr_process.pl +++ b/mysql-test/lib/mtr_process.pl @@ -18,985 +18,13 @@ # and is part of the translation of the Bourne shell script with the # same name. +use strict; 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_ndbmgm_start($$); -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 - # FIXME we should only give up the suite, not all of the run? - print STDERR "\n"; - 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(mysqld, ndbd, ndb_mgmd and im) that would conflict with -# this run -# Make sure to remove the PID file, if any. -# kill IM manager first, else it will restart the servers -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 - } - - if ( ! $::opt_skip_ndbcluster ) - { - - foreach my $cluster (@{$::clusters}) - { - - # Don't shut down a "running" cluster - next if $cluster->{'use_running'}; - - mtr_debug(" - cluster " . - "(pid: $cluster->{pid}; " . - "pid file: '$cluster->{path_pid})"); - - my $pid= mtr_ndbmgm_start($cluster, "shutdown"); - - # Save the pid of the ndb_mgm process - $admin_pids{$pid}= 1; - - push(@kill_pids,{ - pid => $cluster->{'pid'}, - pidfile => $cluster->{'path_pid'} - }); - - $cluster->{'pid'}= 0; # Assume we are done with it - - foreach my $ndbd (@{$cluster->{'ndbds'}}) - { - mtr_debug(" - ndbd " . - "(pid: $ndbd->{pid}; " . - "pid file: '$ndbd->{path_pid})"); - - push(@kill_pids,{ - pid => $ndbd->{'pid'}, - pidfile => $ndbd->{'path_pid'}, - }); - $ndbd->{'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."); - } - } - } - else - { - mtr_warning("Found non pid file $elem in $rundir") - if -f "$rundir/$elem"; - next; - } - } - 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; - -} - -# Start "ndb_mgm shutdown" for a specific cluster, it will -# shutdown all data nodes and leave the ndb_mgmd running -sub mtr_ndbmgm_start($$) { - my $cluster= shift; - my $command= shift; - - my $args; - - mtr_init_args(\$args); - - mtr_add_arg($args, "--no-defaults"); - mtr_add_arg($args, "--core"); - mtr_add_arg($args, "--try-reconnect=1"); - mtr_add_arg($args, "--ndb_connectstring=%s", $cluster->{'connect_string'}); - mtr_add_arg($args, "-e"); - mtr_add_arg($args, "$command"); - - my $pid= mtr_spawn($::exe_ndb_mgm, $args, - "", "/dev/null", "/dev/null", "", - {}); - mtr_verbose("mtr_ndbmgm_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; - } - } - - foreach my $cluster (@{$::clusters}) - { - if ( $cluster->{'pid'} eq $ret_pid ) - { - mtr_verbose("$cluster->{'name'} cluster ndb_mgmd exited, pid: $ret_pid"); - $cluster->{'pid'}= 0; - return; - } - - foreach my $ndbd (@{$cluster->{'ndbds'}}) - { - if ( $ndbd->{'pid'} eq $ret_pid ) - { - mtr_verbose("$cluster->{'name'} cluster ndbd exited, pid: $ret_pid"); - $ndbd->{'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"; - if ( -f $expect_file ) - { - mtr_verbose("Crash was expected, file $expect_file exists"); - mysqld_start($mysqld, $mysqld->{'start_opts'}, - $mysqld->{'start_slave_master_info'}); - unlink($expect_file); - } - - return; - } - } - - foreach my $cluster (@{$::clusters}) - { - if ( $cluster->{'pid'} eq $ret_pid ) - { - mtr_verbose("$cluster->{'name'} cluster ndb_mgmd exited, pid: $ret_pid"); - $cluster->{'pid'}= 0; - - # Check if crash expected and restart if it was - my $expect_file= "$::opt_vardir/tmp/ndb_mgmd_" . "$cluster->{'type'}" . - ".expect"; - if ( -f $expect_file ) - { - mtr_verbose("Crash was expected, file $expect_file exists"); - ndbmgmd_start($cluster); - unlink($expect_file); - } - return; - } - - foreach my $ndbd (@{$cluster->{'ndbds'}}) - { - if ( $ndbd->{'pid'} eq $ret_pid ) - { - mtr_verbose("$cluster->{'name'} cluster ndbd exited, pid: $ret_pid"); - $ndbd->{'pid'}= 0; - - # Check if crash expected and restart if it was - my $expect_file= "$::opt_vardir/tmp/ndbd_" . "$cluster->{'type'}" . - "$ndbd->{'idx'}" . ".expect"; - if ( -f $expect_file ) - { - mtr_verbose("Crash was expected, file $expect_file exists"); - ndbd_start($cluster, $ndbd->{'idx'}, - $ndbd->{'start_extra_args'}); - unlink($expect_file); - } - return; - } - } - } - - if ($::instance_manager->{'spawner_pid'} eq $ret_pid) - { - 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; @@ -1041,7 +69,7 @@ sub mtr_ping_port ($) { sub sleep_until_file_created ($$$) { my $pidfile= shift; my $timeout= shift; - my $pid= shift; + my $proc= shift; my $sleeptime= 100; # Milliseconds my $loops= ($timeout * 1000) / $sleeptime; @@ -1053,9 +81,9 @@ sub sleep_until_file_created ($$$) { } # Check if it died after the fork() was successful - if ( $pid != 0 && waitpid($pid,&WNOHANG) == $pid ) + if ( defined $proc and ! $proc->wait_one(0) ) { - mtr_warning("Process $pid died"); + mtr_warning("Process $proc died"); return 0; } @@ -1070,73 +98,12 @@ sub sleep_until_file_created ($$$) { "still waiting for $left seconds..."); } - # Millisceond sleep emulated with select - select(undef, undef, undef, ($sleeptime/1000)); - } - - return 0; -} - + mtr_milli_sleep($sleeptime); -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); + return 0; } -########################################################################### 1; diff --git a/mysql-test/lib/mtr_report.pl b/mysql-test/lib/mtr_report.pl index d345740c5c2..f3b950e4d3a 100644 --- a/mysql-test/lib/mtr_report.pl +++ b/mysql-test/lib/mtr_report.pl @@ -21,46 +21,42 @@ use strict; use warnings; -sub mtr_report_test_name($); -sub mtr_report_test_passed($); -sub mtr_report_test_failed($); +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_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}; + + # Remove suite part of name + $tname =~ s/.*\.// unless SHOW_SUITE_NAME; + + # Add combination name if any $tname.= " '$tinfo->{combination}'" if defined $tinfo->{combination}; - _mtr_log($tname); + _mtr_log("$tname"); printf "%-30s ", $tname; } + sub mtr_report_test_skipped ($) { my $tinfo= shift; + mtr_report_test_name($tinfo); $tinfo->{'result'}= 'MTR_RES_SKIPPED'; if ( $tinfo->{'disable'} ) @@ -69,36 +65,26 @@ sub mtr_report_test_skipped ($) { } elsif ( $tinfo->{'comment'} ) { - mtr_report("[ skipped ] $tinfo->{'comment'}"); + if ( $tinfo->{skip_detected_by_test} ) + { + mtr_report("[ skip.] $tinfo->{'comment'}"); + } else { + mtr_report("[ skip ] $tinfo->{'comment'}"); + } } else { - mtr_report("[ skipped ]"); + mtr_report("[ skip ]"); } } -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; +sub mtr_report_test_passed ($$) { + my ($tinfo, $use_timer)= @_; + mtr_report_test_name($tinfo); my $timer= ""; - if ( $::opt_timer and -f "$::opt_vardir/log/timer" ) + if ( $use_timer and -f "$::opt_vardir/log/timer" ) { $timer= mtr_fromfile("$::opt_vardir/log/timer"); $tot_real_time += ($timer/1000); @@ -108,8 +94,10 @@ sub mtr_report_test_passed ($) { mtr_report("[ pass ] $timer"); } -sub mtr_report_test_failed ($) { - my $tinfo= shift; + +sub mtr_report_test_failed ($$) { + my ($tinfo, $logfile)= @_; + mtr_report_test_name($tinfo); $tinfo->{'result'}= 'MTR_RES_FAILED'; if ( defined $tinfo->{'timeout'} ) @@ -129,12 +117,12 @@ sub mtr_report_test_failed ($) { # failing the test is saved in "comment" mtr_report("\nERROR: $tinfo->{'comment'}"); } - elsif ( -f $::path_timefile ) + elsif ( defined $logfile and -f $logfile ) { - # Test failure was detected by test tool and it's report + # Test failure was detected by test tool and its report # about what failed has been saved to file. Display the report. print "\n"; - print mtr_fromfile($::path_timefile); # FIXME print_file() instead + mtr_printfile($logfile); print "\n"; } else @@ -145,6 +133,7 @@ sub mtr_report_test_failed ($) { } } + sub mtr_report_stats ($) { my $tests= shift; @@ -184,28 +173,7 @@ sub mtr_report_stats ($) { # ---------------------------------------------------------------------- # 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"; - } + print "The servers were restarted $tot_restarts times\n"; if ( $::opt_timer ) { @@ -220,7 +188,7 @@ sub mtr_report_stats ($) { # the "var/log/*.err" files. We save this info in "var/log/warnings" # ---------------------------------------------------------------------- - if ( ! $::glob_use_running_server ) + if ( $::opt_warnings ) { # Save and report if there was any fatal warnings/errors in err logs @@ -346,19 +314,11 @@ sub mtr_report_stats ($) { # BUG#29807 - innodb_mysql.test: Cannot find table test/t2 # from the internal data dictionary - /Cannot find or open table test\/bug29807 from/ or + /Cannot find table test\/bug29807 from the internal data dictionary/ 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 - - # 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_code: 1054/ or - /Slave: Can't DROP 'c7'.* 1091/ or - /Slave: Key column 'c6'.* 1072/ - + /Cannot find table test\/BUG29839 from the internal data dictionary/ ) { next; # Skip these lines @@ -400,23 +360,6 @@ sub mtr_report_stats ($) { 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 ) { @@ -438,12 +381,47 @@ sub mtr_report_stats ($) { } } + # Print a list of testcases that failed + if ( $tot_failed != 0 ) + { + 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):"; + + foreach my $tinfo (@$tests) + { + if ( $tinfo->{'result'} eq 'MTR_RES_FAILED' ) + { + print " $tinfo->{'name'}"; + } + } + 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"; + } + if ( $tot_failed != 0 || $found_problems) { mtr_error("there were failing test cases"); } } + ############################################################################## # # Text formatting @@ -451,22 +429,25 @@ sub mtr_report_stats ($) { ############################################################################## sub mtr_print_line () { - print '-' x 55, "\n"; + print '-' x 60, "\n"; } -sub mtr_print_thick_line () { - print '=' x 55, "\n"; + +sub mtr_print_thick_line ($) { + my $char= shift || '='; + print $char x 60, "\n"; } + sub mtr_print_header () { print "\n"; if ( $::opt_timer ) { - print "TEST RESULT TIME (ms)\n"; + print "TEST RESULT TIME (ms)\n"; } else { - print "TEST RESULT\n"; + print "TEST RESULT\n"; } mtr_print_line(); print "\n"; @@ -480,6 +461,14 @@ sub mtr_print_header () { ############################################################################## use IO::File; +use Time::localtime; + +sub _timestamp { + my $tm= localtime(); + return sprintf("%02d%02d%02d %2d:%02d:%02d ", + $tm->year % 100, $tm->mon+1, $tm->mday, + $tm->hour, $tm->min, $tm->sec); +} my $log_file_ref= undef; @@ -492,46 +481,44 @@ sub mtr_log_init ($) { mtr_warning("Could not create logfile $filename: $!"); } + sub _mtr_log (@) { - print $log_file_ref join(" ", @_),"\n" + print $log_file_ref join(" ", _timestamp(), @_),"\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 ) + if ( $::opt_verbose > 1 ) { _mtr_log("###: ", @_); print STDERR "####: ",join(" ", @_),"\n"; } } + sub mtr_verbose (@) { # Always print to log, print to screen only when --verbose is used _mtr_log("> ",@_); @@ -541,4 +528,5 @@ sub mtr_verbose (@) { } } + 1; diff --git a/mysql-test/lib/mtr_settings.pl b/mysql-test/lib/mtr_settings.pl new file mode 100644 index 00000000000..01ba4c9516e --- /dev/null +++ b/mysql-test/lib/mtr_settings.pl @@ -0,0 +1,16 @@ +# +# Defines used to control how mysql-test-run.pl +# should work in the current version of MySQL +# + +# Control if the suite name should be output before testname +sub SHOW_SUITE_NAME { return 1; }; + + +# Control which suites are run by default +sub DEFAULT_SUITES { return "main,binlog,federated,rpl,rpl_ndb,ndb"; }; + + + +1; + diff --git a/mysql-test/lib/mtr_stress.pl b/mysql-test/lib/mtr_stress.pl index 93b06b32c5f..cd5c7b0dbb7 100644 --- a/mysql-test/lib/mtr_stress.pl +++ b/mysql-test/lib/mtr_stress.pl @@ -135,7 +135,7 @@ sub run_stress_test () } mtr_init_args(\$args); - + mtr_add_args($args, "$::glob_mysql_test_dir/mysql-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"); @@ -181,7 +181,13 @@ sub run_stress_test () } #Run stress test - mtr_run("$::glob_mysql_test_dir/mysql-stress-test.pl", $args, "", "", "", ""); + My::SafeProcess->run + ( + name => "stress test", + path => $^X, + args => \$args, + ); + if ( ! $::glob_use_embedded_server ) { stop_all_servers(); diff --git a/mysql-test/lib/mtr_timer.pl b/mysql-test/lib/mtr_timer.pl deleted file mode 100644 index 326fbea74ec..00000000000 --- a/mysql-test/lib/mtr_timer.pl +++ /dev/null @@ -1,158 +0,0 @@ -# -*- cperl -*- -# Copyright (C) 2005-2006 MySQL AB -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; version 2 of the License. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA - -# This is a library file used by the Perl version of mysql-test-run, -# and is part of the translation of the Bourne shell script with the -# same name. - -use 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_verbose("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_verbose("timer $$ woke up, exiting!"); - exit(0); - }; - - $0= "mtr_timer(timers,$name,$duration)"; - sleep($duration); - mtr_verbose("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/t/Base.t b/mysql-test/lib/t/Base.t new file mode 100644 index 00000000000..6ca7657d421 --- /dev/null +++ b/mysql-test/lib/t/Base.t @@ -0,0 +1,27 @@ +# -*- cperl -*- +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 00000000000..90489ba06dd --- /dev/null +++ b/mysql-test/lib/t/Find.t @@ -0,0 +1,33 @@ +# -*- cperl -*- +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/SafeProcess.t b/mysql-test/lib/t/SafeProcess.t new file mode 100644 index 00000000000..d4a62ff8cca --- /dev/null +++ b/mysql-test/lib/t/SafeProcess.t @@ -0,0 +1,102 @@ +# -*- cperl -*- + +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 00000000000..a31f3031262 --- /dev/null +++ b/mysql-test/lib/t/SafeProcessStress.pl @@ -0,0 +1,149 @@ +#!/usr/bin/perl +# -*- cperl -*- + +use strict; +use FindBin; +use My::SafeProcess; + +# +# Test longterm running of SafeProcess +# + +my $perl_path= $^X; +my $verbose= 0; +my $loops= 1000; + +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 kiled 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 00000000000..15e4d1a7b1b --- /dev/null +++ b/mysql-test/lib/t/copytree.t @@ -0,0 +1,34 @@ +#!/usr/bin/perl +# -*- cperl -*- + +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 00000000000..07336e3c2d2 --- /dev/null +++ b/mysql-test/lib/t/dummyd.pl @@ -0,0 +1,38 @@ +#!/usr/bin/perl +# -*- cperl -*- + +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 00000000000..08c9077d001 --- /dev/null +++ b/mysql-test/lib/t/rmtree.t @@ -0,0 +1,52 @@ +#!/usr/bin/perl +# -*- cperl -*- + +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 00000000000..da08cb8b4d1 --- /dev/null +++ b/mysql-test/lib/t/testMyConfig.t @@ -0,0 +1,131 @@ +#!/usr/bin/perl +# -*- cperl -*- + +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 overriden by value in test_include.cnf"); + +is( $config3->value('mysqld', 'option1'), 'values3', + "mysqld_option1 has been overriden 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 00000000000..16fdd9db539 --- /dev/null +++ b/mysql-test/lib/t/testMyConfigFactory.t @@ -0,0 +1,98 @@ +#!/usr/bin/perl +# -*- cperl -*- + +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", 'language') =~ /$basedir.*english$/, + "'language' generated"); + +ok ( $config->value("ENV", 'MASTER_MY_PORT') =~ /\d/, + "'language' 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 00000000000..99f4e68003d --- /dev/null +++ b/mysql-test/lib/t/test_child.pl @@ -0,0 +1,21 @@ +#!/usr/bin/perl +# -*- cperl -*- + +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); + + |