mirror of
https://github.com/MariaDB/server.git
synced 2025-07-30 16:24:05 +03:00
Merge pilot.mysql.com:/data/msvensson/mysql/mysql-5.1-rpl
into pilot.mysql.com:/data/msvensson/mysql/mysql-5.1-mtr BitKeeper/etc/ignore: auto-union BitKeeper/deleted/.del-rpl_row_charset.test: Auto merged BitKeeper/deleted/.del-rpl_row_charset_innodb.test: Auto merged CMakeLists.txt: Auto merged client/mysqltest.c: Auto merged configure.in: Auto merged mysql-test/extra/binlog_tests/blackhole.test: Auto merged mysql-test/extra/binlog_tests/mix_innodb_myisam_side_effects.test: Auto merged mysql-test/include/mix1.inc: Auto merged mysql-test/r/ctype_big5.result: Auto merged mysql-test/r/gis.result: Auto merged mysql-test/r/mysqlbinlog.result: Auto merged mysql-test/r/query_cache.result: Auto merged mysql-test/r/sp.result: Auto merged mysql-test/r/system_mysql_db.result: Auto merged mysql-test/r/trigger.result: Auto merged mysql-test/r/type_blob.result: Auto merged mysql-test/r/view.result: Auto merged mysql-test/r/warnings.result: Auto merged mysql-test/suite/federated/federated.result: Auto merged mysql-test/suite/federated/federated.test: Auto merged mysql-test/suite/ndb_team/r/ndb_dd_backuprestore.result: Auto merged mysql-test/suite/ndb_team/r/rpl_ndb_dd_advance.result: Auto merged mysql-test/suite/ndb_team/t/rpl_ndb_dd_advance.test: Auto merged mysql-test/suite/rpl/r/rpl_innodb_mixed_dml.result: Auto merged mysql-test/suite/rpl/r/rpl_row_log_innodb.result: Auto merged mysql-test/suite/rpl/r/rpl_timezone.result: Auto merged mysql-test/suite/rpl/t/rpl_load_from_master.test: Auto merged mysql-test/suite/rpl/t/rpl_rotate_logs.test: Auto merged mysql-test/suite/rpl/t/rpl_trigger.test: Auto merged mysql-test/t/csv.test: Auto merged mysql-test/t/ctype_big5.test: Auto merged mysql-test/t/gis.test: Auto merged mysql-test/t/innodb.test: Auto merged mysql-test/t/mysqldump.test: Auto merged mysql-test/t/partition.test: Auto merged mysql-test/t/query_cache.test: Auto merged mysql-test/t/show_check.test: Auto merged mysql-test/t/sp.test: Auto merged mysql-test/t/system_mysql_db_fix50117.test: Auto merged mysql-test/t/trigger.test: Auto merged mysql-test/t/trigger_notembedded.test: Auto merged mysql-test/t/type_blob.test: Auto merged mysql-test/t/view.test: Auto merged mysql-test/t/warnings.test: Auto merged sql/ha_ndbcluster.cc: Auto merged mysql-test/Makefile.am: SCCS merged mysql-test/mysql-test-run.pl: Use local version of mtr.pl mysql-test/lib/mtr_cases.pm: Use local mtr_cases.pm mysql-test/suite/rpl/t/disabled.def: Use remote disabled file mysql-test/t/disabled.def: Use remote disabled file sql/ha_ndbcluster_binlog.cc: Use remote mysql-test/extra/rpl_tests/rpl_charset.test: Manual merge mysql-test/lib/mtr_report.pm: Manual merge mysql-test/suite/binlog/r/binlog_killed_simulate.result: Manual merge mysql-test/suite/binlog/r/binlog_multi_engine.result: Manual merge mysql-test/suite/binlog/r/binlog_row_mix_innodb_myisam.result: Manual merge mysql-test/suite/binlog/r/binlog_stm_blackhole.result: Manual merge mysql-test/suite/binlog/r/binlog_stm_mix_innodb_myisam.result: Manual merge mysql-test/suite/binlog/t/binlog_killed.test: Manual merge mysql-test/suite/binlog/t/binlog_killed_simulate.test: Manual merge mysql-test/suite/binlog/t/binlog_row_mix_innodb_myisam.test: Manual merge mysql-test/suite/binlog/t/binlog_stm_mix_innodb_myisam.test: Manual merge mysql-test/suite/ndb/r/ndb_binlog_format.result: Manual merge mysql-test/suite/ndb/r/ndb_restore.result: Manual merge mysql-test/suite/ndb/t/ndb_restore.test: Manual merge mysql-test/suite/rpl/include/rpl_mixed_dml.inc: Manual merge mysql-test/suite/rpl/r/rpl_stm_log.result: Manual merge mysql-test/suite/rpl/t/rpl_row_sp005.test: Manual merge mysql-test/t/log_state.test: Manual merge mysql-test/t/mysqlbinlog.test: Manual merge mysql-test/t/mysqlbinlog2.test: Manual merge mysql-test/t/upgrade.test: Manual merge
This commit is contained in:
unknown
@ -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;
|
||||
|
||||
621
mysql-test/lib/My/ConfigFactory.pm
Normal file
621
mysql-test/lib/My/ConfigFactory.pm
Normal file
@ -0,0 +1,621 @@
|
||||
# -*- 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 ssl_supported {
|
||||
my ($self)= @_;
|
||||
return $self->{ARGS}->{ssl};
|
||||
}
|
||||
|
||||
sub fix_ssl_ca {
|
||||
return if !ssl_supported(@_);
|
||||
my $std_data= fix_std_data(@_);
|
||||
return "$std_data/cacert.pem"
|
||||
}
|
||||
|
||||
sub fix_ssl_server_cert {
|
||||
return if !ssl_supported(@_);
|
||||
my $std_data= fix_std_data(@_);
|
||||
return "$std_data/server-cert.pem"
|
||||
}
|
||||
|
||||
sub fix_ssl_client_cert {
|
||||
return if !ssl_supported(@_);
|
||||
my $std_data= fix_std_data(@_);
|
||||
return "$std_data/client-cert.pem"
|
||||
}
|
||||
|
||||
sub fix_ssl_server_key {
|
||||
return if !ssl_supported(@_);
|
||||
my $std_data= fix_std_data(@_);
|
||||
return "$std_data/server-key.pem"
|
||||
}
|
||||
|
||||
sub fix_ssl_client_key {
|
||||
return if !ssl_supported(@_);
|
||||
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}; } },
|
||||
{ 'ssl-ca' => \&fix_ssl_ca },
|
||||
{ 'ssl-cert' => \&fix_ssl_server_cert },
|
||||
{ '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=
|
||||
(
|
||||
{ 'ssl-ca' => \&fix_ssl_ca },
|
||||
{ 'ssl-cert' => \&fix_ssl_client_cert },
|
||||
{ '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 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())
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# Generate [embedded] by copying the values
|
||||
# needed from first [mysqld.<suffix>]
|
||||
#
|
||||
sub post_check_embedded_group {
|
||||
my ($self, $config)= @_;
|
||||
|
||||
return unless $self->{ARGS}->{embedded};
|
||||
|
||||
my $first_mysqld= $config->first_like('mysqld.') or
|
||||
croak "Can't run with embedded, config has no mysqld";
|
||||
|
||||
my @no_copy =
|
||||
(
|
||||
'log-error', # Embedded server writes stderr to mysqltest's log file
|
||||
);
|
||||
|
||||
foreach my $option ( $first_mysqld->options() ) {
|
||||
# Don't copy options whose name is in "no_copy" list
|
||||
next if grep ( $option->name() eq $_, @no_copy);
|
||||
|
||||
$config->insert('embedded', $option->name(), $option->value())
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
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,
|
||||
\&post_check_embedded_group,
|
||||
);
|
||||
|
||||
|
||||
sub run_rules_for_group {
|
||||
my ($self, $config, $group, @rules)= @_;
|
||||
foreach my $hash ( @rules ) {
|
||||
while (my ($option, $rule)= each( %{$hash} )) {
|
||||
# Only run this rule if the value is not already defined
|
||||
if (!$config->exists($group->name(), $option)) {
|
||||
my $value;
|
||||
if (ref $rule eq "CODE") {
|
||||
# Call the rule function
|
||||
$value= &$rule($self, $config, $group->name(),
|
||||
$config->group($group->name()));
|
||||
} else {
|
||||
$value= $rule;
|
||||
}
|
||||
if (defined $value) {
|
||||
$config->insert($group->name(), $option, $value, 1);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub run_section_rules {
|
||||
my ($self, $config, $name, @rules)= @_;
|
||||
|
||||
foreach my $group ( $config->like($name) ) {
|
||||
$self->run_rules_for_group($config, $group, @rules);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub 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 rules required for [client]
|
||||
$self->run_rules_for_group($config,
|
||||
$config->insert('client'),
|
||||
@client_rules);
|
||||
|
||||
|
||||
# Additional rules required for [mysqltest]
|
||||
$self->run_rules_for_group($config,
|
||||
$config->insert('mysqltest'),
|
||||
@mysqltest_rules);
|
||||
|
||||
{
|
||||
# Run post rules
|
||||
foreach my $rule ( @post_rules ) {
|
||||
&$rule($self, $config);
|
||||
}
|
||||
}
|
||||
|
||||
return $config;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
83
mysql-test/lib/My/File/Path.pm
Normal file
83
mysql-test/lib/My/File/Path.pm
Normal file
@ -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;
|
||||
190
mysql-test/lib/My/Find.pm
Normal file
190
mysql-test/lib/My/Find.pm
Normal file
@ -0,0 +1,190 @@
|
||||
# -*- 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 Carp;
|
||||
use My::Platform;
|
||||
|
||||
use base qw(Exporter);
|
||||
our @EXPORT= qw(my_find_bin my_find_dir);
|
||||
|
||||
our $vs_config_dir;
|
||||
|
||||
my $bin_extension= ".exe" if IS_WINDOWS;
|
||||
|
||||
#
|
||||
# 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)= @_;
|
||||
croak "usage: my_find_bin(<base>, <paths>, <names>)"
|
||||
unless @_ == 3;
|
||||
|
||||
# -------------------------------------------------------
|
||||
# Find and return the first executable
|
||||
# -------------------------------------------------------
|
||||
foreach my $path (my_find_paths($base, $paths, $names, $bin_extension)) {
|
||||
return $path if ( -x $path or (IS_WINDOWS 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)= @_;
|
||||
croak "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, $extension)= @_;
|
||||
|
||||
# Convert the arguments into two normal arrays to ease
|
||||
# further mappings
|
||||
my (@names, @paths);
|
||||
push(@names, ref $names eq "ARRAY" ? @$names : $names);
|
||||
push(@paths, ref $paths eq "ARRAY" ? @$paths : $paths);
|
||||
|
||||
#print "base: $base\n";
|
||||
#print "names: @names\n";
|
||||
#print "paths: @paths\n";
|
||||
|
||||
# User can select to look in a special build dir
|
||||
# which is a subdirectory of any of the paths
|
||||
my @extra_dirs;
|
||||
my $build_dir= $vs_config_dir || $ENV{MTR_VS_CONFIG} || $ENV{MTR_BUILD_DIR};
|
||||
push(@extra_dirs, $build_dir) if defined $build_dir;
|
||||
|
||||
if (defined $extension){
|
||||
# Append extension to names, if name does not already have extension
|
||||
map { $_.=$extension unless /\.(.*)+$/ } @names;
|
||||
}
|
||||
|
||||
# -------------------------------------------------------
|
||||
# Windows specific
|
||||
# -------------------------------------------------------
|
||||
if (IS_WINDOWS) {
|
||||
# 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 commify {
|
||||
return
|
||||
(@_ == 0) ? '' :
|
||||
(@_ == 1) ? $_[0] :
|
||||
(@_ == 2) ? join(" or ", @_) :
|
||||
join(", ", @_[0..($#_-1)], "or $_[-1]");
|
||||
|
||||
}
|
||||
|
||||
|
||||
sub fnuttify {
|
||||
return map('\''.$_.'\'', @_);
|
||||
}
|
||||
|
||||
|
||||
sub find_error {
|
||||
my ($base, $paths, $names)= @_;
|
||||
|
||||
my (@names, @paths);
|
||||
push(@names, ref $names eq "ARRAY" ? @$names : $names);
|
||||
push(@paths, ref $paths eq "ARRAY" ? @$paths : $paths);
|
||||
|
||||
croak "** ERROR: Could not find ",
|
||||
commify(fnuttify(@names)), " in ",
|
||||
commify(fnuttify(my_find_paths($base, $paths, $names))), "\n";
|
||||
}
|
||||
|
||||
1;
|
||||
196
mysql-test/lib/My/Options.pm
Normal file
196
mysql-test/lib/My/Options.pm
Normal file
@ -0,0 +1,196 @@
|
||||
# -*- 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::Options;
|
||||
|
||||
#
|
||||
# Utility functions to work with list of options
|
||||
#
|
||||
|
||||
use strict;
|
||||
|
||||
|
||||
sub same($$) {
|
||||
my $l1= shift;
|
||||
my $l2= shift;
|
||||
return compare($l1,$l2) == 0;
|
||||
}
|
||||
|
||||
|
||||
sub compare ($$) {
|
||||
my $l1= shift;
|
||||
my $l2= shift;
|
||||
|
||||
my @l1= @$l1;
|
||||
my @l2= @$l2;
|
||||
|
||||
return -1 if @l1 < @l2;
|
||||
return 1 if @l1 > @l2;
|
||||
|
||||
while ( @l1 ) # Same length
|
||||
{
|
||||
my $e1= shift @l1;
|
||||
my $e2= shift @l2;
|
||||
my $cmp= ($e1 cmp $e2);
|
||||
return $cmp if $cmp != 0;
|
||||
}
|
||||
|
||||
return 0; # They are the same
|
||||
}
|
||||
|
||||
|
||||
sub _split_option {
|
||||
my ($option)= @_;
|
||||
if ($option=~ /^--(.*)=(.*)$/){
|
||||
return ($1, $2);
|
||||
}
|
||||
elsif ($option=~ /^--(.*)$/){
|
||||
return ($1, undef)
|
||||
}
|
||||
elsif ($option=~ /^(.*)=(.*)$/){
|
||||
return ($1, $2)
|
||||
}
|
||||
elsif ($option=~ /^-O$/){
|
||||
return (undef, undef);
|
||||
}
|
||||
die "Unknown option format '$option'";
|
||||
}
|
||||
|
||||
|
||||
sub _build_option {
|
||||
my ($name, $value)= @_;
|
||||
if ($name =~ /^O, /){
|
||||
return "-".$name."=".$value;
|
||||
}
|
||||
elsif ($value){
|
||||
return "--".$name."=".$value;
|
||||
}
|
||||
return "--".$name;
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# Compare two list of options and return what would need
|
||||
# to be done to get the server running with the new settings
|
||||
#
|
||||
sub diff {
|
||||
my ($from_opts, $to_opts)= @_;
|
||||
|
||||
my %from;
|
||||
foreach my $from (@$from_opts)
|
||||
{
|
||||
my ($opt, $value)= _split_option($from);
|
||||
next unless defined($opt);
|
||||
$from{$opt}= $value;
|
||||
}
|
||||
|
||||
#print "from: ", %from, "\n";
|
||||
|
||||
my %to;
|
||||
foreach my $to (@$to_opts)
|
||||
{
|
||||
my ($opt, $value)= _split_option($to);
|
||||
next unless defined($opt);
|
||||
$to{$opt}= $value;
|
||||
}
|
||||
|
||||
#print "to: ", %to, "\n";
|
||||
|
||||
# Remove the ones that are in both lists
|
||||
foreach my $name (keys %from){
|
||||
if (exists $to{$name} and $to{$name} eq $from{$name}){
|
||||
#print "removing '$name' from both lists\n";
|
||||
delete $to{$name};
|
||||
delete $from{$name};
|
||||
}
|
||||
}
|
||||
|
||||
#print "from: ", %from, "\n";
|
||||
#print "to: ", %to, "\n";
|
||||
|
||||
# Add all keys in "to" to result
|
||||
my @result;
|
||||
foreach my $name (keys %to){
|
||||
push(@result, _build_option($name, $to{$name}));
|
||||
}
|
||||
|
||||
# Add all keys in "from" that are not in "to"
|
||||
# to result as "set to default"
|
||||
foreach my $name (keys %from){
|
||||
if (not exists $to{$name}) {
|
||||
push(@result, _build_option($name, "default"));
|
||||
}
|
||||
}
|
||||
|
||||
return @result;
|
||||
}
|
||||
|
||||
|
||||
sub is_set {
|
||||
my ($opts, $set_opts)= @_;
|
||||
|
||||
foreach my $opt (@$opts){
|
||||
|
||||
my ($opt_name1, $value1)= _split_option($opt);
|
||||
|
||||
foreach my $set_opt (@$set_opts){
|
||||
my ($opt_name2, $value2)= _split_option($set_opt);
|
||||
|
||||
if ($opt_name1 eq $opt_name2){
|
||||
# Option already set
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
sub toSQL {
|
||||
my (@options)= @_;
|
||||
my @sql;
|
||||
|
||||
foreach my $option (@options) {
|
||||
my ($name, $value)= _split_option($option);
|
||||
#print "name: $name\n";
|
||||
#print "value: $value\n";
|
||||
if ($name =~ /^O, (.*)/){
|
||||
push(@sql, "SET GLOBAL $1=$value");
|
||||
}
|
||||
elsif ($name =~ /^set-variable=(.*)/){
|
||||
push(@sql, "SET GLOBAL $1=$value");
|
||||
}
|
||||
else {
|
||||
my $sql_name= $name;
|
||||
$sql_name=~ s/-/_/g;
|
||||
push(@sql, "SET GLOBAL $sql_name=$value");
|
||||
}
|
||||
}
|
||||
return join("; ", @sql);
|
||||
}
|
||||
|
||||
|
||||
sub toStr {
|
||||
my $name= shift;
|
||||
return "$name: ",
|
||||
"['", join("', '", @_), "']\n";
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
95
mysql-test/lib/My/Platform.pm
Normal file
95
mysql-test/lib/My/Platform.pm
Normal file
@ -0,0 +1,95 @@
|
||||
# -*- 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::Platform;
|
||||
|
||||
use strict;
|
||||
|
||||
use base qw(Exporter);
|
||||
our @EXPORT= qw(IS_CYGWIN IS_WINDOWS IS_WIN32PERL
|
||||
native_path posix_path mixed_path);
|
||||
|
||||
BEGIN {
|
||||
if ($^O eq "cygwin") {
|
||||
# Make sure cygpath works
|
||||
if ((system("cygpath > /dev/null 2>&1") >> 8) != 1){
|
||||
die "Could not execute 'cygpath': $!";
|
||||
}
|
||||
eval 'sub IS_CYGWIN { 1 }';
|
||||
}
|
||||
else {
|
||||
eval 'sub IS_CYGWIN { 0 }';
|
||||
}
|
||||
if ($^O eq "MSWin32") {
|
||||
eval 'sub IS_WIN32PERL { 1 }';
|
||||
}
|
||||
else {
|
||||
eval 'sub IS_WIN32PERL { 0 }';
|
||||
}
|
||||
}
|
||||
|
||||
BEGIN {
|
||||
if (IS_CYGWIN or IS_WIN32PERL) {
|
||||
eval 'sub IS_WINDOWS { 1 }';
|
||||
}
|
||||
else {
|
||||
eval 'sub IS_WINDOWS { 0 }';
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# native_path
|
||||
# Convert from path format used by perl to the underlying
|
||||
# operating systems format
|
||||
#
|
||||
# NOTE
|
||||
# Used when running windows binaries (that expect windows paths)
|
||||
# in cygwin perl (that uses unix paths)
|
||||
#
|
||||
|
||||
sub mixed_path {
|
||||
my ($path)= @_;
|
||||
if (IS_CYGWIN){
|
||||
return unless defined $path;
|
||||
$path= `cygpath -m $path`;
|
||||
chomp $path;
|
||||
}
|
||||
return $path;
|
||||
}
|
||||
|
||||
|
||||
sub native_path {
|
||||
my ($path)= @_;
|
||||
$path=~ s/\//\\/g
|
||||
if (IS_CYGWIN or IS_WIN32PERL);
|
||||
return $path;
|
||||
}
|
||||
|
||||
|
||||
sub posix_path {
|
||||
my ($path)= @_;
|
||||
if (IS_CYGWIN){
|
||||
return unless defined $path;
|
||||
$path= `cygpath $path`;
|
||||
chomp $path;
|
||||
}
|
||||
return $path;
|
||||
}
|
||||
|
||||
|
||||
|
||||
1;
|
||||
512
mysql-test/lib/My/SafeProcess.pm
Normal file
512
mysql-test/lib/My/SafeProcess.pm
Normal file
@ -0,0 +1,512 @@
|
||||
# -*- 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;
|
||||
use My::Platform;
|
||||
|
||||
my %running;
|
||||
|
||||
END {
|
||||
# Kill any children still running
|
||||
for my $proc (values %running){
|
||||
if ( $proc->is_child($$) ){
|
||||
print "Killing: $proc\n";
|
||||
$proc->kill();
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub is_child {
|
||||
my ($self, $parent_pid)= @_;
|
||||
die "usage: \$safe_proc->is_child()" unless (@_ == 2 and ref $self);
|
||||
return ($self->{PARENT} == $parent_pid);
|
||||
}
|
||||
|
||||
|
||||
# Find the safe process binary or script
|
||||
my @safe_process_cmd;
|
||||
my $safe_kill;
|
||||
if (IS_WIN32PERL or IS_CYGWIN){
|
||||
# Use my_safe_process.exe
|
||||
my $exe= my_find_bin(".", ["lib/My/SafeProcess", "My/SafeProcess"],
|
||||
"my_safe_process");
|
||||
die "Could not find my_safe_process" unless $exe;
|
||||
push(@safe_process_cmd, $exe);
|
||||
|
||||
# Use my_safe_kill.exe
|
||||
$safe_kill= my_find_bin(".", "lib/My/SafeProcess", "my_safe_kill");
|
||||
die "Could not find my_safe_kill" unless $safe_kill;
|
||||
}
|
||||
else
|
||||
{
|
||||
my $use_safe_process_binary= 1;
|
||||
if ($use_safe_process_binary) {
|
||||
# Use my_safe_process
|
||||
my $exe= my_find_bin(".", ["lib/My/SafeProcess", "My/SafeProcess"],
|
||||
"my_safe_process");
|
||||
die "Could not find my_safe_process" unless $exe;
|
||||
push(@safe_process_cmd, $exe);
|
||||
}
|
||||
else
|
||||
{
|
||||
# Use safe_process.pl
|
||||
my $script= "lib/My/SafeProcess/safe_process.pl";
|
||||
$script= "../$script" unless -f $script;
|
||||
die "Could not find safe_process.pl" unless -f $script;
|
||||
|
||||
# Call $script with Perl interpreter
|
||||
push(@safe_process_cmd, $^X, $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){
|
||||
$path= mixed_path($path);
|
||||
$input= mixed_path($input);
|
||||
$output= mixed_path($output);
|
||||
$error= mixed_path($error);
|
||||
}
|
||||
|
||||
my @safe_args;
|
||||
my ($safe_path, $safe_script)= @safe_process_cmd;
|
||||
push(@safe_args, $safe_script) if defined $safe_script;
|
||||
|
||||
push(@safe_args, "--verbose") if $verbose > 0;
|
||||
|
||||
# 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,
|
||||
PARENT => $$,
|
||||
}, $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",
|
||||
PARENT => $$,
|
||||
}, $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;
|
||||
236
mysql-test/lib/My/SafeProcess/Base.pm
Normal file
236
mysql-test/lib/My/SafeProcess/Base.pm
Normal file
@ -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;
|
||||
|
||||
17
mysql-test/lib/My/SafeProcess/CMakeLists.txt
Normal file
17
mysql-test/lib/My/SafeProcess/CMakeLists.txt
Normal file
@ -0,0 +1,17 @@
|
||||
# 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
|
||||
|
||||
ADD_EXECUTABLE(my_safe_process safe_process_win.cc)
|
||||
ADD_EXECUTABLE(my_safe_kill safe_kill_win.cc)
|
||||
21
mysql-test/lib/My/SafeProcess/Makefile.am
Normal file
21
mysql-test/lib/My/SafeProcess/Makefile.am
Normal file
@ -0,0 +1,21 @@
|
||||
# Copyright (C) 2000-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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
|
||||
bin_PROGRAMS = my_safe_process
|
||||
|
||||
my_safe_process_SOURCES = safe_process.cc
|
||||
|
||||
# Don't update the files from bitkeeper
|
||||
%::SCCS/s.%
|
||||
56
mysql-test/lib/My/SafeProcess/safe_kill_win.cc
Executable file
56
mysql-test/lib/My/SafeProcess/safe_kill_win.cc
Executable file
@ -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);
|
||||
}
|
||||
|
||||
267
mysql-test/lib/My/SafeProcess/safe_process.cc
Normal file
267
mysql-test/lib/My/SafeProcess/safe_process.cc
Normal file
@ -0,0 +1,267 @@
|
||||
/* Copyright (C) 2008 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)
|
||||
|
||||
*/
|
||||
|
||||
#include <sys/types.h>
|
||||
#include <sys/wait.h>
|
||||
#include <unistd.h>
|
||||
#include <stdarg.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <signal.h>
|
||||
#include <string.h>
|
||||
#include <errno.h>
|
||||
|
||||
int verbose= 0;
|
||||
int terminated= 0;
|
||||
pid_t child_pid= -1;
|
||||
char safe_process_name[32]= {0};
|
||||
|
||||
|
||||
static void message(const char* fmt, ...)
|
||||
{
|
||||
if (!verbose)
|
||||
return;
|
||||
va_list args;
|
||||
fprintf(stderr, "%s: ", safe_process_name);
|
||||
va_start(args, fmt);
|
||||
vfprintf(stderr, fmt, args);
|
||||
fprintf(stderr, "\n");
|
||||
va_end(args);
|
||||
fflush(stderr);
|
||||
}
|
||||
|
||||
|
||||
static void die(const char* fmt, ...)
|
||||
{
|
||||
va_list args;
|
||||
fprintf(stderr, "%s: FATAL ERROR, ", safe_process_name);
|
||||
va_start(args, fmt);
|
||||
vfprintf(stderr, fmt, args);
|
||||
fprintf(stderr, "\n");
|
||||
va_end(args);
|
||||
if (int last_err= errno)
|
||||
fprintf(stderr, "error: %d, %s\n", last_err, strerror(last_err));
|
||||
exit(1);
|
||||
}
|
||||
|
||||
|
||||
static void kill_child (void)
|
||||
{
|
||||
int exit_code= 1;
|
||||
int status= 0;
|
||||
|
||||
message("Killing child: %d", child_pid);
|
||||
// Terminate whole process group
|
||||
kill(-child_pid, SIGKILL);
|
||||
|
||||
pid_t ret_pid= waitpid(child_pid, &status, 0);
|
||||
if (ret_pid == child_pid)
|
||||
{
|
||||
if (WIFEXITED(status))
|
||||
{
|
||||
// Process has exited, collect return status
|
||||
exit_code= WEXITSTATUS(status);
|
||||
message("Child exit: %d", exit_code);
|
||||
// Exit with exit status of the child
|
||||
exit(exit_code);
|
||||
}
|
||||
|
||||
if (WIFSIGNALED(status))
|
||||
message("Child killed by signal: %d", WTERMSIG(status));
|
||||
|
||||
exit(exit_code);
|
||||
}
|
||||
exit(exit_code);
|
||||
}
|
||||
|
||||
|
||||
static void handle_signal (int sig)
|
||||
{
|
||||
message("Got signal %d, child_pid: %d", sig, child_pid);
|
||||
terminated= 1;
|
||||
|
||||
// Ignore further signals
|
||||
signal(SIGTERM, SIG_IGN);
|
||||
signal(SIGINT, SIG_IGN);
|
||||
signal(SIGCHLD, SIG_IGN);
|
||||
|
||||
if (child_pid > 0)
|
||||
kill_child();
|
||||
|
||||
// Continune execution, allow the child to be started and
|
||||
// finally terminated by monitor loop
|
||||
}
|
||||
|
||||
|
||||
int main(int argc, char* const argv[] )
|
||||
{
|
||||
char* const* child_argv= 0;
|
||||
pid_t own_pid= getpid();
|
||||
pid_t parent_pid= getppid();
|
||||
|
||||
/* Install signal handlers */
|
||||
signal(SIGTERM, handle_signal);
|
||||
signal(SIGINT, handle_signal);
|
||||
signal(SIGCHLD, handle_signal);
|
||||
|
||||
sprintf(safe_process_name, "safe_process[%d]", own_pid);
|
||||
|
||||
message("Started");
|
||||
|
||||
/* Parse arguments */
|
||||
for (int i= 1; i < argc; i++) {
|
||||
const char* arg= argv[i];
|
||||
if (strcmp(arg, "--") == 0 && strlen(arg) == 2) {
|
||||
/* Got the "--" delimiter */
|
||||
if (i >= argc)
|
||||
die("No real args -> nothing to do");
|
||||
child_argv= &argv[i+1];
|
||||
break;
|
||||
} else {
|
||||
if ( strcmp(arg, "--verbose") == 0 )
|
||||
verbose++;
|
||||
else if ( strncmp(arg, "--parent-pid", 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_argv || *child_argv == 0)
|
||||
die("nothing to do");
|
||||
|
||||
message("parent_pid: %d", parent_pid);
|
||||
if (parent_pid == own_pid)
|
||||
die("parent_pid is equal to own pid!");
|
||||
|
||||
char buf;
|
||||
int pfd[2];
|
||||
if (pipe(pfd) == -1)
|
||||
die("Failed to create pipe");
|
||||
|
||||
/* Create the child process */
|
||||
while((child_pid= fork()) == -1)
|
||||
{
|
||||
message("fork failed");
|
||||
sleep(1);
|
||||
}
|
||||
|
||||
if (child_pid == 0)
|
||||
{
|
||||
close(pfd[0]); // Close unused read end
|
||||
|
||||
// Use default signal handlers in child
|
||||
signal(SIGTERM, SIG_DFL);
|
||||
signal(SIGINT, SIG_DFL);
|
||||
signal(SIGCHLD, SIG_DFL);
|
||||
|
||||
// Make this process it's own process group to be able to kill
|
||||
// it and any childs(that hasn't changed group themself)
|
||||
setpgid(0, 0);
|
||||
|
||||
// Signal that child is ready
|
||||
buf= 37;
|
||||
write(pfd[1], &buf, 1);
|
||||
// Close write end
|
||||
close(pfd[1]);
|
||||
|
||||
if (execvp(child_argv[0], child_argv) < 0)
|
||||
die("Failed to exec child");
|
||||
}
|
||||
|
||||
close(pfd[1]); // Close unused write end
|
||||
|
||||
// Wait for child to signal it's ready
|
||||
read(pfd[0], &buf, 1);
|
||||
if(buf != 37)
|
||||
die("Didn't get 37 from pipe");
|
||||
close(pfd[0]); // Close read end
|
||||
|
||||
/* Monitor loop */
|
||||
message("Started child %d, terminated: %d", child_pid, terminated);
|
||||
|
||||
while(!terminated)
|
||||
{
|
||||
// Check if parent is still alive
|
||||
if (kill(parent_pid, 0) != 0){
|
||||
message("Parent is not alive anymore");
|
||||
break;
|
||||
}
|
||||
|
||||
// Check if child has exited, normally this wil be
|
||||
// detected immediately with SIGCHLD handler
|
||||
int status= 0;
|
||||
pid_t ret_pid= waitpid(child_pid, &status, WNOHANG);
|
||||
if (ret_pid == child_pid)
|
||||
{
|
||||
int ret_code= 2;
|
||||
if (WIFEXITED(status))
|
||||
{
|
||||
// Process has exited, collect return status
|
||||
int ret_code= WEXITSTATUS(status);
|
||||
message("Child exit: %d", ret_code);
|
||||
// Exit with exit status of the child
|
||||
exit(ret_code);
|
||||
}
|
||||
|
||||
if (WIFSIGNALED(status))
|
||||
message("Child killed by signal: %d", WTERMSIG(status));
|
||||
|
||||
exit(ret_code);
|
||||
}
|
||||
sleep(1);
|
||||
}
|
||||
kill_child();
|
||||
|
||||
exit(1);
|
||||
}
|
||||
|
||||
151
mysql-test/lib/My/SafeProcess/safe_process.pl
Normal file
151
mysql-test/lib/My/SafeProcess/safe_process.pl
Normal file
@ -0,0 +1,151 @@
|
||||
#!/usr/bin/perl
|
||||
# -*- cperl -*-
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
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){
|
||||
use Time::localtime;
|
||||
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();
|
||||
|
||||
my $found_double_dash= 0;
|
||||
while (my $arg= shift(@ARGV)){
|
||||
|
||||
if ($arg =~ /^--$/){
|
||||
$found_double_dash= 1;
|
||||
last;
|
||||
}
|
||||
elsif ($arg =~ /^--verbose$/){
|
||||
$verbose= 1;
|
||||
}
|
||||
else {
|
||||
die "Unknown option: $arg";
|
||||
}
|
||||
}
|
||||
|
||||
my $path= shift(@ARGV); # Executable
|
||||
|
||||
die "usage:\n" .
|
||||
" safe_process.pl [opts] -- <path> [<args> [...<args_n>]]"
|
||||
unless defined $path || $found_double_dash;
|
||||
|
||||
|
||||
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);
|
||||
|
||||
|
||||
312
mysql-test/lib/My/SafeProcess/safe_process_win.cc
Executable file
312
mysql-test/lib/My/SafeProcess/safe_process_win.cc
Executable file
@ -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);
|
||||
}
|
||||
|
||||
@ -1,960 +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 File::Basename;
|
||||
use IO::File();
|
||||
use strict;
|
||||
|
||||
use My::Config;
|
||||
|
||||
sub collect_test_cases ($);
|
||||
sub collect_one_suite ($);
|
||||
sub collect_one_test_case ($$$$$$$$$);
|
||||
|
||||
sub mtr_options_from_test_file($$);
|
||||
|
||||
my $do_test;
|
||||
my $skip_test;
|
||||
|
||||
sub init_pattern {
|
||||
my ($from, $what)= @_;
|
||||
if ( $from =~ /^[a-z0-9]$/ ) {
|
||||
# Does not contain any regex, make the pattern match
|
||||
# beginning of string
|
||||
$from= "^$from";
|
||||
}
|
||||
# Check that pattern is a valid regex
|
||||
eval { "" =~/$from/; 1 } or
|
||||
mtr_error("Invalid regex '$from' passed to $what\nPerl says: $@");
|
||||
return $from;
|
||||
}
|
||||
|
||||
|
||||
|
||||
##############################################################################
|
||||
#
|
||||
# Collect information about test cases we are to run
|
||||
#
|
||||
##############################################################################
|
||||
|
||||
sub collect_test_cases ($) {
|
||||
$do_test= init_pattern($::opt_do_test, "--do-test");
|
||||
$skip_test= init_pattern($::opt_skip_test, "--skip-test");
|
||||
|
||||
my $suites= shift; # Semicolon separated list of test suites
|
||||
my $cases = []; # Array of hash
|
||||
|
||||
foreach my $suite (split(",", $suites))
|
||||
{
|
||||
push(@$cases, collect_one_suite($suite));
|
||||
}
|
||||
|
||||
|
||||
if ( @::opt_cases )
|
||||
{
|
||||
# Check that the tests specified was found
|
||||
# in at least one suite
|
||||
foreach my $test_name_spec ( @::opt_cases )
|
||||
{
|
||||
my $found= 0;
|
||||
my ($sname, $tname, $extension)= split_testname($test_name_spec);
|
||||
foreach my $test ( @$cases )
|
||||
{
|
||||
# test->{name} is always in suite.name format
|
||||
if ( $test->{name} =~ /.*\.$tname/ )
|
||||
{
|
||||
$found= 1;
|
||||
}
|
||||
}
|
||||
if ( not $found )
|
||||
{
|
||||
mtr_error("Could not find $tname in any suite");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $::opt_reorder )
|
||||
{
|
||||
# Reorder the test cases in an order that will make them faster to run
|
||||
my %sort_criteria;
|
||||
|
||||
# Make a mapping of test name to a string that represents how that test
|
||||
# should be sorted among the other tests. Put the most important criterion
|
||||
# first, then a sub-criterion, then sub-sub-criterion, et c.
|
||||
foreach my $tinfo (@$cases)
|
||||
{
|
||||
my @criteria = ();
|
||||
|
||||
# Look for tests that muct be in run in a defined order
|
||||
# that is defined by test having the same name except for
|
||||
# the ending digit
|
||||
|
||||
# Put variables into hash
|
||||
my $test_name= $tinfo->{'name'};
|
||||
my $depend_on_test_name;
|
||||
if ( $test_name =~ /^([\D]+)([0-9]{1})$/ )
|
||||
{
|
||||
my $base_name= $1;
|
||||
my $idx= $2;
|
||||
mtr_verbose("$test_name => $base_name idx=$idx");
|
||||
if ( $idx > 1 )
|
||||
{
|
||||
$idx-= 1;
|
||||
$base_name= "$base_name$idx";
|
||||
mtr_verbose("New basename $base_name");
|
||||
}
|
||||
|
||||
foreach my $tinfo2 (@$cases)
|
||||
{
|
||||
if ( $tinfo2->{'name'} eq $base_name )
|
||||
{
|
||||
mtr_verbose("found dependent test $tinfo2->{'name'}");
|
||||
$depend_on_test_name=$base_name;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( defined $depend_on_test_name )
|
||||
{
|
||||
mtr_verbose("Giving $test_name same critera as $depend_on_test_name");
|
||||
$sort_criteria{$test_name} = $sort_criteria{$depend_on_test_name};
|
||||
}
|
||||
else
|
||||
{
|
||||
#
|
||||
# Append the criteria for sorting, in order of importance.
|
||||
#
|
||||
push(@criteria, "ndb=" . ($tinfo->{'ndb_test'} ? "1" : "0"));
|
||||
# Group test with equal options together.
|
||||
# Ending with "~" makes empty sort later than filled
|
||||
push(@criteria, join("!", sort @{$tinfo->{'master_opt'}}) . "~");
|
||||
|
||||
$sort_criteria{$test_name} = join(" ", @criteria);
|
||||
}
|
||||
}
|
||||
|
||||
@$cases = sort {
|
||||
$sort_criteria{$a->{'name'}} . $a->{'name'} cmp
|
||||
$sort_criteria{$b->{'name'}} . $b->{'name'}; } @$cases;
|
||||
|
||||
if ( $::opt_script_debug )
|
||||
{
|
||||
# For debugging the sort-order
|
||||
foreach my $tinfo (@$cases)
|
||||
{
|
||||
print("$sort_criteria{$tinfo->{'name'}} -> \t$tinfo->{'name'}\n");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return $cases;
|
||||
|
||||
}
|
||||
|
||||
# Valid extensions and their corresonding component id
|
||||
my %exts = ( 'test' => 'mysqld',
|
||||
'imtest' => 'im'
|
||||
);
|
||||
|
||||
|
||||
# Returns (suitename, testname, extension)
|
||||
sub split_testname {
|
||||
my ($test_name)= @_;
|
||||
|
||||
# Get rid of directory part and split name on .'s
|
||||
my @parts= split(/\./, basename($test_name));
|
||||
|
||||
if (@parts == 1){
|
||||
# Only testname given, ex: alias
|
||||
return (undef , $parts[0], undef);
|
||||
} elsif (@parts == 2) {
|
||||
# Either testname.test or suite.testname given
|
||||
# Ex. main.alias or alias.test
|
||||
|
||||
if (defined $exts{$parts[1]})
|
||||
{
|
||||
return (undef , $parts[0], $parts[1]);
|
||||
}
|
||||
else
|
||||
{
|
||||
return ($parts[0], $parts[1], undef);
|
||||
}
|
||||
|
||||
} elsif (@parts == 3) {
|
||||
# Fully specified suitename.testname.test
|
||||
# ex main.alias.test
|
||||
return ( $parts[0], $parts[1], $parts[2]);
|
||||
}
|
||||
|
||||
mtr_error("Illegal format of test name: $test_name");
|
||||
}
|
||||
|
||||
|
||||
sub collect_one_suite($)
|
||||
{
|
||||
my $suite= shift; # Test suite name
|
||||
my @cases; # Array of hash
|
||||
|
||||
mtr_verbose("Collecting: $suite");
|
||||
|
||||
my $suitedir= "$::glob_mysql_test_dir"; # Default
|
||||
if ( $suite ne "main" )
|
||||
{
|
||||
$suitedir= mtr_path_exists("$suitedir/suite/$suite",
|
||||
"$suitedir/$suite");
|
||||
mtr_verbose("suitedir: $suitedir");
|
||||
}
|
||||
|
||||
my $testdir= "$suitedir/t";
|
||||
my $resdir= "$suitedir/r";
|
||||
|
||||
# ----------------------------------------------------------------------
|
||||
# Build a hash of disabled testcases for this suite
|
||||
# ----------------------------------------------------------------------
|
||||
my %disabled;
|
||||
if ( open(DISABLED, "$testdir/disabled.def" ) )
|
||||
{
|
||||
while ( <DISABLED> )
|
||||
{
|
||||
chomp;
|
||||
if ( /^\s*(\S+)\s*:\s*(.*?)\s*$/ )
|
||||
{
|
||||
$disabled{$1}= $2;
|
||||
}
|
||||
}
|
||||
close DISABLED;
|
||||
}
|
||||
|
||||
# Read suite.opt file
|
||||
my $suite_opt_file= "$testdir/suite.opt";
|
||||
my $suite_opts= [];
|
||||
if ( -f $suite_opt_file )
|
||||
{
|
||||
$suite_opts= mtr_get_opts_from_file($suite_opt_file);
|
||||
}
|
||||
|
||||
if ( @::opt_cases )
|
||||
{
|
||||
# Collect in specified order
|
||||
foreach my $test_name_spec ( @::opt_cases )
|
||||
{
|
||||
my ($sname, $tname, $extension)= split_testname($test_name_spec);
|
||||
|
||||
# The test name parts have now been defined
|
||||
#print " suite_name: $sname\n";
|
||||
#print " tname: $tname\n";
|
||||
#print " extension: $extension\n";
|
||||
|
||||
# Check cirrect suite if suitename is defined
|
||||
next if (defined $sname and $suite ne $sname);
|
||||
|
||||
my $component_id;
|
||||
if ( defined $extension )
|
||||
{
|
||||
my $full_name= "$testdir/$tname.$extension";
|
||||
# Extension was specified, check if the test exists
|
||||
if ( ! -f $full_name)
|
||||
{
|
||||
# This is only an error if suite was specified, otherwise it
|
||||
# could exist in another suite
|
||||
mtr_error("Test '$full_name' was not found in suite '$sname'")
|
||||
if $sname;
|
||||
|
||||
next;
|
||||
}
|
||||
$component_id= $exts{$extension};
|
||||
}
|
||||
else
|
||||
{
|
||||
# No extension was specified
|
||||
my ($ext, $component);
|
||||
while (($ext, $component)= each %exts) {
|
||||
my $full_name= "$testdir/$tname.$ext";
|
||||
|
||||
if ( ! -f $full_name ) {
|
||||
next;
|
||||
}
|
||||
$component_id= $component;
|
||||
$extension= $ext;
|
||||
}
|
||||
# Test not found here, could exist in other suite
|
||||
next unless $component_id;
|
||||
}
|
||||
|
||||
collect_one_test_case($testdir,$resdir,$suite,$tname,
|
||||
"$tname.$extension",\@cases,\%disabled,
|
||||
$component_id,$suite_opts);
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
opendir(TESTDIR, $testdir) or mtr_error("Can't open dir \"$testdir\": $!");
|
||||
|
||||
foreach my $elem ( sort readdir(TESTDIR) )
|
||||
{
|
||||
my $component_id= undef;
|
||||
my $tname= undef;
|
||||
|
||||
if ($tname= mtr_match_extension($elem, 'test'))
|
||||
{
|
||||
$component_id = 'mysqld';
|
||||
}
|
||||
elsif ($tname= mtr_match_extension($elem, 'imtest'))
|
||||
{
|
||||
$component_id = 'im';
|
||||
}
|
||||
else
|
||||
{
|
||||
next;
|
||||
}
|
||||
|
||||
# Skip tests that does not match the --do-test= filter
|
||||
next if ($do_test and not $tname =~ /$do_test/o);
|
||||
|
||||
collect_one_test_case($testdir,$resdir,$suite,$tname,
|
||||
$elem,\@cases,\%disabled,$component_id,
|
||||
$suite_opts);
|
||||
}
|
||||
closedir TESTDIR;
|
||||
}
|
||||
|
||||
|
||||
# Return empty list if no testcases found
|
||||
return if (@cases == 0);
|
||||
|
||||
# ----------------------------------------------------------------------
|
||||
# Read combinations for this suite and build testcases x combinations
|
||||
# if any combinations exists
|
||||
# ----------------------------------------------------------------------
|
||||
if ( ! $::opt_skip_combination )
|
||||
{
|
||||
my @combinations;
|
||||
my $combination_file= "$suitedir/combinations";
|
||||
#print "combination_file: $combination_file\n";
|
||||
if (@::opt_combinations)
|
||||
{
|
||||
# take the combination from command-line
|
||||
mtr_verbose("Take the combination from command line");
|
||||
foreach my $combination (@::opt_combinations) {
|
||||
my $comb= {};
|
||||
$comb->{name}= $combination;
|
||||
push(@{$comb->{comb_opt}}, $combination);
|
||||
push(@combinations, $comb);
|
||||
}
|
||||
}
|
||||
elsif (-f $combination_file )
|
||||
{
|
||||
# Read combinations file in my.cnf format
|
||||
mtr_verbose("Read combinations file");
|
||||
my $config= My::Config->new($combination_file);
|
||||
|
||||
foreach my $group ($config->groups()) {
|
||||
my $comb= {};
|
||||
$comb->{name}= $group->name();
|
||||
foreach my $option ( $group->options() ) {
|
||||
push(@{$comb->{comb_opt}}, $option->name()."=".$option->value());
|
||||
}
|
||||
push(@combinations, $comb);
|
||||
}
|
||||
}
|
||||
|
||||
if (@combinations)
|
||||
{
|
||||
print " - adding combinations\n";
|
||||
#print_testcases(@cases);
|
||||
|
||||
my @new_cases;
|
||||
foreach my $comb (@combinations)
|
||||
{
|
||||
foreach my $test (@cases)
|
||||
{
|
||||
#print $test->{name}, " ", $comb, "\n";
|
||||
my $new_test= {};
|
||||
|
||||
while (my ($key, $value) = each(%$test)) {
|
||||
if (ref $value eq "ARRAY") {
|
||||
push(@{$new_test->{$key}}, @$value);
|
||||
} else {
|
||||
$new_test->{$key}= $value;
|
||||
}
|
||||
}
|
||||
|
||||
# Append the combination options to master_opt and slave_opt
|
||||
push(@{$new_test->{master_opt}}, @{$comb->{comb_opt}});
|
||||
push(@{$new_test->{slave_opt}}, @{$comb->{comb_opt}});
|
||||
|
||||
# Add combination name shrt name
|
||||
$new_test->{combination}= $comb->{name};
|
||||
|
||||
# Add the new test to new test cases list
|
||||
push(@new_cases, $new_test);
|
||||
}
|
||||
}
|
||||
#print_testcases(@new_cases);
|
||||
@cases= @new_cases;
|
||||
#print_testcases(@cases);
|
||||
}
|
||||
}
|
||||
|
||||
optimize_cases(\@cases);
|
||||
#print_testcases(@cases);
|
||||
|
||||
return @cases;
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# Loop through all test cases
|
||||
# - optimize which test to run by skipping unnecessary ones
|
||||
# - update settings if necessary
|
||||
#
|
||||
sub optimize_cases {
|
||||
my ($cases)= @_;
|
||||
|
||||
foreach my $tinfo ( @$cases )
|
||||
{
|
||||
# Skip processing if already marked as skipped
|
||||
next if $tinfo->{skip};
|
||||
|
||||
# Replication test needs an adjustment of binlog format
|
||||
if (mtr_match_prefix($tinfo->{'name'}, "rpl"))
|
||||
{
|
||||
|
||||
# =======================================================
|
||||
# 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
|
||||
# =======================================================
|
||||
if ($test_binlog_format and defined $tinfo->{'sup_binlog_formats'} )
|
||||
{
|
||||
my $supported=
|
||||
grep { $_ eq $test_binlog_format } @{$tinfo->{'sup_binlog_formats'}};
|
||||
if ( !$supported )
|
||||
{
|
||||
$tinfo->{'skip'}= 1;
|
||||
$tinfo->{'comment'}=
|
||||
"Doesn't support --binlog-format='$test_binlog_format'";
|
||||
next;
|
||||
}
|
||||
}
|
||||
|
||||
# =======================================================
|
||||
# Use dynamic switching of binlog-format if mtr started
|
||||
# w/o --mysqld=--binlog-format=xxx and combinations.
|
||||
# =======================================================
|
||||
if (!defined $tinfo->{'combination'} and
|
||||
!defined $::used_binlog_format)
|
||||
{
|
||||
$test_binlog_format= $tinfo->{'sup_binlog_formats'}->[0];
|
||||
}
|
||||
|
||||
# Save binlog format for dynamic switching
|
||||
$tinfo->{binlog_format}= $test_binlog_format;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
##############################################################################
|
||||
#
|
||||
# Collect information about a single test case
|
||||
#
|
||||
##############################################################################
|
||||
|
||||
|
||||
sub collect_one_test_case($$$$$$$$$) {
|
||||
my $testdir= shift;
|
||||
my $resdir= shift;
|
||||
my $suite= shift;
|
||||
my $tname= shift;
|
||||
my $elem= shift;
|
||||
my $cases= shift;
|
||||
my $disabled=shift;
|
||||
my $component_id= shift;
|
||||
my $suite_opts= shift;
|
||||
|
||||
my $path= "$testdir/$elem";
|
||||
|
||||
# ----------------------------------------------------------------------
|
||||
# Skip some tests silently
|
||||
# ----------------------------------------------------------------------
|
||||
|
||||
if ( $::opt_start_from and $tname lt $::opt_start_from )
|
||||
{
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
my $tinfo= {};
|
||||
$tinfo->{'name'}= basename($suite) . ".$tname";
|
||||
$tinfo->{'result_file'}= "$resdir/$tname.result";
|
||||
$tinfo->{'component_id'} = $component_id;
|
||||
push(@$cases, $tinfo);
|
||||
|
||||
# ----------------------------------------------------------------------
|
||||
# Skip some tests but include in list, just mark them to skip
|
||||
# ----------------------------------------------------------------------
|
||||
|
||||
if ( $skip_test and $tname =~ /$skip_test/o )
|
||||
{
|
||||
$tinfo->{'skip'}= 1;
|
||||
return;
|
||||
}
|
||||
|
||||
# ----------------------------------------------------------------------
|
||||
# Collect information about test case
|
||||
# ----------------------------------------------------------------------
|
||||
|
||||
$tinfo->{'path'}= $path;
|
||||
$tinfo->{'timezone'}= "GMT-3"; # for UNIX_TIMESTAMP tests to work
|
||||
|
||||
$tinfo->{'slave_num'}= 0; # Default, no slave
|
||||
$tinfo->{'master_num'}= 1; # Default, 1 master
|
||||
if ( defined mtr_match_prefix($tname,"rpl") )
|
||||
{
|
||||
if ( $::opt_skip_rpl )
|
||||
{
|
||||
$tinfo->{'skip'}= 1;
|
||||
$tinfo->{'comment'}= "No replication tests(--skip-rpl)";
|
||||
return;
|
||||
}
|
||||
|
||||
$tinfo->{'slave_num'}= 1; # Default for rpl* tests, use one slave
|
||||
|
||||
}
|
||||
|
||||
if ( defined mtr_match_prefix($tname,"federated") )
|
||||
{
|
||||
# Default, federated uses the first slave as it's federated database
|
||||
$tinfo->{'slave_num'}= 1;
|
||||
}
|
||||
|
||||
my $master_opt_file= "$testdir/$tname-master.opt";
|
||||
my $slave_opt_file= "$testdir/$tname-slave.opt";
|
||||
my $slave_mi_file= "$testdir/$tname.slave-mi";
|
||||
my $master_sh= "$testdir/$tname-master.sh";
|
||||
my $slave_sh= "$testdir/$tname-slave.sh";
|
||||
my $disabled_file= "$testdir/$tname.disabled";
|
||||
my $im_opt_file= "$testdir/$tname-im.opt";
|
||||
|
||||
$tinfo->{'master_opt'}= [];
|
||||
$tinfo->{'slave_opt'}= [];
|
||||
$tinfo->{'slave_mi'}= [];
|
||||
|
||||
|
||||
# Add suite opts
|
||||
foreach my $opt ( @$suite_opts )
|
||||
{
|
||||
mtr_verbose($opt);
|
||||
push(@{$tinfo->{'master_opt'}}, $opt);
|
||||
push(@{$tinfo->{'slave_opt'}}, $opt);
|
||||
}
|
||||
|
||||
# Add master opts
|
||||
if ( -f $master_opt_file )
|
||||
{
|
||||
|
||||
my $master_opt= mtr_get_opts_from_file($master_opt_file);
|
||||
|
||||
foreach my $opt ( @$master_opt )
|
||||
{
|
||||
my $value;
|
||||
|
||||
# The opt file is used both to send special options to the mysqld
|
||||
# as well as pass special test case specific options to this
|
||||
# script
|
||||
|
||||
$value= mtr_match_prefix($opt, "--timezone=");
|
||||
if ( defined $value )
|
||||
{
|
||||
$tinfo->{'timezone'}= $value;
|
||||
next;
|
||||
}
|
||||
|
||||
$value= mtr_match_prefix($opt, "--slave-num=");
|
||||
if ( defined $value )
|
||||
{
|
||||
$tinfo->{'slave_num'}= $value;
|
||||
next;
|
||||
}
|
||||
|
||||
$value= mtr_match_prefix($opt, "--result-file=");
|
||||
if ( defined $value )
|
||||
{
|
||||
# Specifies the file mysqltest should compare
|
||||
# output against
|
||||
$tinfo->{'result_file'}= "r/$value.result";
|
||||
next;
|
||||
}
|
||||
|
||||
# If we set default time zone, remove the one we have
|
||||
$value= mtr_match_prefix($opt, "--default-time-zone=");
|
||||
if ( defined $value )
|
||||
{
|
||||
# Set timezone for this test case to something different
|
||||
$tinfo->{'timezone'}= "GMT-8";
|
||||
# Fallthrough, add the --default-time-zone option
|
||||
}
|
||||
|
||||
# The --restart option forces a restart even if no special
|
||||
# option is set. If the options are the same as next testcase
|
||||
# there is no need to restart after the testcase
|
||||
# has completed
|
||||
if ( $opt eq "--force-restart" )
|
||||
{
|
||||
$tinfo->{'force_restart'}= 1;
|
||||
next;
|
||||
}
|
||||
|
||||
# Ok, this was a real option, add it
|
||||
push(@{$tinfo->{'master_opt'}}, $opt);
|
||||
}
|
||||
}
|
||||
|
||||
# Add slave opts
|
||||
if ( -f $slave_opt_file )
|
||||
{
|
||||
my $slave_opt= mtr_get_opts_from_file($slave_opt_file);
|
||||
|
||||
foreach my $opt ( @$slave_opt )
|
||||
{
|
||||
# If we set default time zone, remove the one we have
|
||||
my $value= mtr_match_prefix($opt, "--default-time-zone=");
|
||||
$tinfo->{'slave_opt'}= [] if defined $value;
|
||||
}
|
||||
push(@{$tinfo->{'slave_opt'}}, @$slave_opt);
|
||||
}
|
||||
|
||||
if ( -f $slave_mi_file )
|
||||
{
|
||||
$tinfo->{'slave_mi'}= mtr_get_opts_from_file($slave_mi_file);
|
||||
}
|
||||
|
||||
if ( -f $master_sh )
|
||||
{
|
||||
if ( $::glob_win32_perl )
|
||||
{
|
||||
$tinfo->{'skip'}= 1;
|
||||
$tinfo->{'comment'}= "No tests with sh scripts on Windows";
|
||||
return;
|
||||
}
|
||||
else
|
||||
{
|
||||
$tinfo->{'master_sh'}= $master_sh;
|
||||
}
|
||||
}
|
||||
|
||||
if ( -f $slave_sh )
|
||||
{
|
||||
if ( $::glob_win32_perl )
|
||||
{
|
||||
$tinfo->{'skip'}= 1;
|
||||
$tinfo->{'comment'}= "No tests with sh scripts on Windows";
|
||||
return;
|
||||
}
|
||||
else
|
||||
{
|
||||
$tinfo->{'slave_sh'}= $slave_sh;
|
||||
}
|
||||
}
|
||||
|
||||
if ( -f $im_opt_file )
|
||||
{
|
||||
$tinfo->{'im_opts'} = mtr_get_opts_from_file($im_opt_file);
|
||||
}
|
||||
else
|
||||
{
|
||||
$tinfo->{'im_opts'} = [];
|
||||
}
|
||||
|
||||
# FIXME why this late?
|
||||
my $marked_as_disabled= 0;
|
||||
if ( $disabled->{$tname} )
|
||||
{
|
||||
$marked_as_disabled= 1;
|
||||
$tinfo->{'comment'}= $disabled->{$tname};
|
||||
}
|
||||
|
||||
if ( -f $disabled_file )
|
||||
{
|
||||
$marked_as_disabled= 1;
|
||||
$tinfo->{'comment'}= mtr_fromfile($disabled_file);
|
||||
}
|
||||
|
||||
# If test was marked as disabled, either opt_enable_disabled is off and then
|
||||
# we skip this test, or it is on and then we run this test but warn
|
||||
|
||||
if ( $marked_as_disabled )
|
||||
{
|
||||
if ( $::opt_enable_disabled )
|
||||
{
|
||||
$tinfo->{'dont_skip_though_disabled'}= 1;
|
||||
}
|
||||
else
|
||||
{
|
||||
$tinfo->{'skip'}= 1;
|
||||
$tinfo->{'disable'}= 1; # Sub type of 'skip'
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
if ( $component_id eq 'im' )
|
||||
{
|
||||
if ( $::glob_use_embedded_server )
|
||||
{
|
||||
$tinfo->{'skip'}= 1;
|
||||
$tinfo->{'comment'}= "No IM with embedded server";
|
||||
return;
|
||||
}
|
||||
elsif ( $::opt_ps_protocol )
|
||||
{
|
||||
$tinfo->{'skip'}= 1;
|
||||
$tinfo->{'comment'}= "No IM with --ps-protocol";
|
||||
return;
|
||||
}
|
||||
elsif ( $::opt_skip_im )
|
||||
{
|
||||
$tinfo->{'skip'}= 1;
|
||||
$tinfo->{'comment'}= "No IM tests(--skip-im)";
|
||||
return;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
mtr_options_from_test_file($tinfo,"$testdir/${tname}.test");
|
||||
|
||||
if ( defined $::used_default_engine )
|
||||
{
|
||||
# Different default engine is used
|
||||
# tag test to require that engine
|
||||
$tinfo->{'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 )
|
||||
{
|
||||
$tinfo->{'skip'}= 1;
|
||||
$tinfo->{'comment'}= "Test need 'big-test' option";
|
||||
return;
|
||||
}
|
||||
|
||||
if ( $tinfo->{'ndb_extra'} and ! $::opt_ndb_extra_test )
|
||||
{
|
||||
$tinfo->{'skip'}= 1;
|
||||
$tinfo->{'comment'}= "Test need 'ndb_extra' option";
|
||||
return;
|
||||
}
|
||||
|
||||
if ( $tinfo->{'require_manager'} )
|
||||
{
|
||||
$tinfo->{'skip'}= 1;
|
||||
$tinfo->{'comment'}= "Test need the _old_ manager(to be removed)";
|
||||
return;
|
||||
}
|
||||
|
||||
if ( $tinfo->{'need_debug'} && ! $::debug_compiled_binaries )
|
||||
{
|
||||
$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;
|
||||
}
|
||||
}
|
||||
|
||||
if ( $tinfo->{'need_binlog'} )
|
||||
{
|
||||
if (grep(/^--skip-log-bin/, @::opt_extra_mysqld_opt) )
|
||||
{
|
||||
$tinfo->{'skip'}= 1;
|
||||
$tinfo->{'comment'}= "Test need binlog";
|
||||
return;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
if ( $::mysql_version_id >= 50100 )
|
||||
{
|
||||
# Test does not need binlog, add --skip-binlog to
|
||||
# the options used when starting it
|
||||
push(@{$tinfo->{'master_opt'}}, "--skip-log-bin");
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# List of tags in the .test files that if found should set
|
||||
# the specified value in "tinfo"
|
||||
our @tags=
|
||||
(
|
||||
["include/have_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_mixed_or_row.inc",
|
||||
"sup_binlog_formats", ["mixed","row"]],
|
||||
["include/have_binlog_format_mixed_or_statement.inc",
|
||||
"sup_binlog_formats", ["mixed","statement"]],
|
||||
["include/have_binlog_format_row_or_statement.inc",
|
||||
"sup_binlog_formats", ["row","statement"]],
|
||||
["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],
|
||||
["include/ndb_master-slave.inc", "ndb_test", 1],
|
||||
["require_manager", "require_manager", 1],
|
||||
);
|
||||
|
||||
sub mtr_options_from_test_file($$) {
|
||||
my $tinfo= shift;
|
||||
my $file= shift;
|
||||
#mtr_verbose("$file");
|
||||
my $F= IO::File->new($file) or mtr_error("can't open file \"$file\": $!");
|
||||
|
||||
while ( my $line= <$F> )
|
||||
{
|
||||
|
||||
# Skip line if it start's with #
|
||||
next if ( $line =~ /^#/ );
|
||||
|
||||
# Match this line against tag in "tags" array
|
||||
foreach my $tag (@tags)
|
||||
{
|
||||
if ( index($line, $tag->[0]) >= 0 )
|
||||
{
|
||||
# Tag matched, assign value to "tinfo"
|
||||
$tinfo->{"$tag->[1]"}= $tag->[2];
|
||||
}
|
||||
}
|
||||
|
||||
# If test sources another file, open it as well
|
||||
if ( $line =~ /^\-\-([[:space:]]*)source(.*)$/ or
|
||||
$line =~ /^([[:space:]]*)source(.*);$/ )
|
||||
{
|
||||
my $value= $2;
|
||||
$value =~ s/^\s+//; # Remove leading space
|
||||
$value =~ s/[[:space:]]+$//; # Remove ending space
|
||||
|
||||
my $sourced_file= "$::glob_mysql_test_dir/$value";
|
||||
if ( -f $sourced_file )
|
||||
{
|
||||
# Only source the file if it exists, we may get
|
||||
# false positives in the regexes above if someone
|
||||
# writes "source nnnn;" in a test case(such as mysqltest.test)
|
||||
mtr_options_from_test_file($tinfo, $sourced_file);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub print_testcases {
|
||||
my (@cases)= @_;
|
||||
|
||||
print "=" x 60, "\n";
|
||||
foreach my $test (@cases){
|
||||
print "[", $test->{name}, "]", "\n";
|
||||
while ((my ($key, $value)) = each(%$test)) {
|
||||
print " ", $key, "=";
|
||||
if (ref $value eq "ARRAY") {
|
||||
print join(", ", @$value);
|
||||
} else {
|
||||
print $value;
|
||||
}
|
||||
print "\n";
|
||||
}
|
||||
print "\n";
|
||||
}
|
||||
print "=" x 60, "\n";
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
1112
mysql-test/lib/mtr_cases.pm
Normal file
1112
mysql-test/lib/mtr_cases.pm
Normal file
File diff suppressed because it is too large
Load Diff
@ -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;
|
||||
@ -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;
|
||||
@ -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;
|
||||
|
||||
@ -19,45 +19,25 @@
|
||||
# same name.
|
||||
|
||||
use strict;
|
||||
use File::Find;
|
||||
|
||||
sub mtr_native_path($);
|
||||
use My::Platform;
|
||||
|
||||
sub mtr_init_args ($);
|
||||
sub mtr_add_arg ($$@);
|
||||
sub mtr_args2str($@);
|
||||
sub mtr_path_exists(@);
|
||||
sub mtr_script_exists(@);
|
||||
sub mtr_file_exists(@);
|
||||
sub mtr_exe_exists(@);
|
||||
sub mtr_exe_maybe_exists(@);
|
||||
sub mtr_copy_dir($$);
|
||||
sub mtr_rmtree($);
|
||||
sub mtr_same_opts($$);
|
||||
sub mtr_cmp_opts($$);
|
||||
|
||||
|
||||
##############################################################################
|
||||
#
|
||||
# Misc
|
||||
# Args
|
||||
#
|
||||
##############################################################################
|
||||
|
||||
# Convert path to OS native format
|
||||
sub mtr_native_path($)
|
||||
{
|
||||
my $path= shift;
|
||||
|
||||
# MySQL version before 5.0 still use cygwin, no need
|
||||
# to convert path
|
||||
return $path
|
||||
if ($::mysql_version_id < 50000);
|
||||
|
||||
$path=~ s/\//\\/g
|
||||
if ($::glob_win32);
|
||||
return $path;
|
||||
}
|
||||
|
||||
|
||||
# FIXME move to own lib
|
||||
|
||||
sub mtr_init_args ($) {
|
||||
my $args = shift;
|
||||
$$args = []; # Empty list
|
||||
@ -68,9 +48,18 @@ sub mtr_add_arg ($$@) {
|
||||
my $format= shift;
|
||||
my @fargs = @_;
|
||||
|
||||
# Quote args if args contain space
|
||||
$format= "\"$format\""
|
||||
if (IS_WINDOWS and grep(/\s/, @fargs));
|
||||
|
||||
push(@$args, sprintf($format, @fargs));
|
||||
}
|
||||
|
||||
sub mtr_args2str($@) {
|
||||
my $exe= shift or die;
|
||||
return join(" ", native_path($exe), @_);
|
||||
}
|
||||
|
||||
##############################################################################
|
||||
|
||||
#
|
||||
@ -100,7 +89,7 @@ sub mtr_path_exists (@) {
|
||||
sub mtr_script_exists (@) {
|
||||
foreach my $path ( @_ )
|
||||
{
|
||||
if($::glob_win32)
|
||||
if(IS_WINDOWS)
|
||||
{
|
||||
return $path if -f $path;
|
||||
}
|
||||
@ -140,11 +129,10 @@ sub mtr_file_exists (@) {
|
||||
sub mtr_exe_maybe_exists (@) {
|
||||
my @path= @_;
|
||||
|
||||
map {$_.= ".exe"} @path if $::glob_win32;
|
||||
map {$_.= ".nlm"} @path if $::glob_netware;
|
||||
map {$_.= ".exe"} @path if IS_WINDOWS;
|
||||
foreach my $path ( @path )
|
||||
{
|
||||
if($::glob_win32)
|
||||
if(IS_WINDOWS)
|
||||
{
|
||||
return $path if -f $path;
|
||||
}
|
||||
@ -179,134 +167,11 @@ sub mtr_exe_exists (@) {
|
||||
}
|
||||
|
||||
|
||||
sub mtr_copy_dir($$) {
|
||||
my $from_dir= shift;
|
||||
my $to_dir= shift;
|
||||
sub mtr_milli_sleep {
|
||||
die "usage: mtr_milli_sleep(milliseconds)" unless @_ == 1;
|
||||
my ($millis)= @_;
|
||||
|
||||
# mtr_verbose("Copying from $from_dir to $to_dir");
|
||||
|
||||
mkpath("$to_dir");
|
||||
opendir(DIR, "$from_dir")
|
||||
or mtr_error("Can't find $from_dir$!");
|
||||
for(readdir(DIR)) {
|
||||
next if "$_" eq "." or "$_" eq "..";
|
||||
if ( -d "$from_dir/$_" )
|
||||
{
|
||||
mtr_copy_dir("$from_dir/$_", "$to_dir/$_");
|
||||
next;
|
||||
}
|
||||
copy("$from_dir/$_", "$to_dir/$_");
|
||||
}
|
||||
closedir(DIR);
|
||||
|
||||
}
|
||||
|
||||
|
||||
sub mtr_rmtree($) {
|
||||
my ($dir)= @_;
|
||||
mtr_verbose("mtr_rmtree: $dir");
|
||||
|
||||
# Try to use File::Path::rmtree. Recent versions
|
||||
# handles removal of directories and files that don't
|
||||
# have full permissions, while older versions
|
||||
# may have a problem with that and we use our own version
|
||||
|
||||
eval { rmtree($dir); };
|
||||
if ( $@ ) {
|
||||
mtr_warning("rmtree($dir) failed, trying with File::Find...");
|
||||
|
||||
my $errors= 0;
|
||||
|
||||
# chmod
|
||||
find( {
|
||||
no_chdir => 1,
|
||||
wanted => sub {
|
||||
chmod(0777, $_)
|
||||
or mtr_warning("couldn't chmod(0777, $_): $!") and $errors++;
|
||||
}
|
||||
},
|
||||
$dir
|
||||
);
|
||||
|
||||
# rm
|
||||
finddepth( {
|
||||
no_chdir => 1,
|
||||
wanted => sub {
|
||||
my $file= $_;
|
||||
# Use special underscore (_) filehandle, caches stat info
|
||||
if (!-l $file and -d _ ) {
|
||||
rmdir($file) or
|
||||
mtr_warning("couldn't rmdir($file): $!") and $errors++;
|
||||
} else {
|
||||
unlink($file)
|
||||
or mtr_warning("couldn't unlink($file): $!") and $errors++;
|
||||
}
|
||||
}
|
||||
},
|
||||
$dir
|
||||
);
|
||||
|
||||
mtr_error("Failed to remove '$dir'") if $errors;
|
||||
|
||||
mtr_report("OK, that worked!");
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub mtr_same_opts ($$) {
|
||||
my $l1= shift;
|
||||
my $l2= shift;
|
||||
return mtr_cmp_opts($l1,$l2) == 0;
|
||||
}
|
||||
|
||||
sub mtr_cmp_opts ($$) {
|
||||
my $l1= shift;
|
||||
my $l2= shift;
|
||||
|
||||
my @l1= @$l1;
|
||||
my @l2= @$l2;
|
||||
|
||||
return -1 if @l1 < @l2;
|
||||
return 1 if @l1 > @l2;
|
||||
|
||||
while ( @l1 ) # Same length
|
||||
{
|
||||
my $e1= shift @l1;
|
||||
my $e2= shift @l2;
|
||||
my $cmp= ($e1 cmp $e2);
|
||||
return $cmp if $cmp != 0;
|
||||
}
|
||||
|
||||
return 0; # They are the same
|
||||
}
|
||||
|
||||
#
|
||||
# Compare two arrays and put all unequal elements into a new one
|
||||
#
|
||||
sub mtr_diff_opts ($$) {
|
||||
my $l1= shift;
|
||||
my $l2= shift;
|
||||
my $f;
|
||||
my $l= [];
|
||||
foreach my $e1 (@$l1)
|
||||
{
|
||||
$f= undef;
|
||||
foreach my $e2 (@$l2)
|
||||
{
|
||||
$f= 1 unless ($e1 ne $e2);
|
||||
}
|
||||
push(@$l, $e1) unless (defined $f);
|
||||
}
|
||||
foreach my $e2 (@$l2)
|
||||
{
|
||||
$f= undef;
|
||||
foreach my $e1 (@$l1)
|
||||
{
|
||||
$f= 1 unless ($e1 ne $e2);
|
||||
}
|
||||
push(@$l, $e2) unless (defined $f);
|
||||
}
|
||||
return $l;
|
||||
select(undef, undef, undef, ($millis/1000));
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -18,49 +18,53 @@
|
||||
# and is part of the translation of the Bourne shell script with the
|
||||
# same name.
|
||||
|
||||
package mtr_report;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
sub mtr_report_test_name($);
|
||||
sub mtr_report_test_passed($);
|
||||
sub mtr_report_test_failed($);
|
||||
sub mtr_report_test_skipped($);
|
||||
sub mtr_report_test_not_skipped_though_disabled($);
|
||||
use base qw(Exporter);
|
||||
our @EXPORT= qw(report_option mtr_print_line mtr_print_thick_line
|
||||
mtr_print_header mtr_report mtr_report_stats
|
||||
mtr_warning mtr_error mtr_debug mtr_verbose
|
||||
mtr_verbose_restart mtr_report_test_passed
|
||||
mtr_report_test_failed mtr_report_test_skipped
|
||||
mtr_report_stats);
|
||||
|
||||
sub mtr_report_stats ($);
|
||||
sub mtr_print_line ();
|
||||
sub mtr_print_thick_line ();
|
||||
sub mtr_print_header ();
|
||||
sub mtr_report (@);
|
||||
sub mtr_warning (@);
|
||||
sub mtr_error (@);
|
||||
sub mtr_child_error (@);
|
||||
sub mtr_debug (@);
|
||||
sub mtr_verbose (@);
|
||||
require "mtr_io.pl";
|
||||
|
||||
my $tot_real_time= 0;
|
||||
|
||||
our $timestamp= 0;
|
||||
|
||||
sub report_option {
|
||||
my ($opt, $value)= @_;
|
||||
|
||||
##############################################################################
|
||||
#
|
||||
#
|
||||
#
|
||||
##############################################################################
|
||||
# Convert - to _ in option name
|
||||
$opt =~ s/-/_/;
|
||||
no strict 'refs';
|
||||
${$opt}= $value;
|
||||
}
|
||||
|
||||
sub mtr_report_test_name ($) {
|
||||
sub SHOW_SUITE_NAME() { return 1; };
|
||||
|
||||
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);
|
||||
print _timestamp();
|
||||
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,49 +73,48 @@ 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);
|
||||
$timer= sprintf "%12s", $timer;
|
||||
}
|
||||
$tinfo->{'result'}= 'MTR_RES_PASSED';
|
||||
# Set as passed unless already set
|
||||
if ( not defined $tinfo->{'result'} ){
|
||||
$tinfo->{'result'}= 'MTR_RES_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';
|
||||
my $test_failures= $tinfo->{'failures'} || 0;
|
||||
$tinfo->{'failures'}= $test_failures + 1;
|
||||
if ( defined $tinfo->{'timeout'} )
|
||||
{
|
||||
mtr_report("[ fail ] timeout");
|
||||
@ -129,12 +132,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 +148,7 @@ sub mtr_report_test_failed ($) {
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub mtr_report_stats ($) {
|
||||
my $tests= shift;
|
||||
|
||||
@ -184,28 +188,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 +203,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
|
||||
|
||||
@ -433,23 +416,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 )
|
||||
{
|
||||
@ -471,12 +437,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
|
||||
@ -484,22 +485,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";
|
||||
@ -512,66 +516,61 @@ sub mtr_print_header () {
|
||||
#
|
||||
##############################################################################
|
||||
|
||||
use IO::File;
|
||||
use Time::localtime;
|
||||
|
||||
my $log_file_ref= undef;
|
||||
sub _timestamp {
|
||||
return "" unless $timestamp;
|
||||
|
||||
sub mtr_log_init ($) {
|
||||
my ($filename)= @_;
|
||||
|
||||
mtr_error("Log is already open") if defined $log_file_ref;
|
||||
|
||||
$log_file_ref= IO::File->new($filename, "a") or
|
||||
mtr_warning("Could not create logfile $filename: $!");
|
||||
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);
|
||||
}
|
||||
|
||||
sub _mtr_log (@) {
|
||||
print $log_file_ref join(" ", @_),"\n"
|
||||
if defined $log_file_ref;
|
||||
}
|
||||
|
||||
# Print message to screen
|
||||
sub mtr_report (@) {
|
||||
# Print message to screen and log
|
||||
_mtr_log(@_);
|
||||
print join(" ", @_),"\n";
|
||||
print join(" ", @_), "\n";
|
||||
}
|
||||
|
||||
|
||||
# Print warning to screen
|
||||
sub mtr_warning (@) {
|
||||
# Print message to screen and log
|
||||
_mtr_log("WARNING: ", @_);
|
||||
print STDERR "mysql-test-run: WARNING: ",join(" ", @_),"\n";
|
||||
print STDERR _timestamp(), "mysql-test-run: WARNING: ", join(" ", @_), "\n";
|
||||
}
|
||||
|
||||
|
||||
# Print error to screen and then exit
|
||||
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";
|
||||
print STDERR _timestamp(), "mysql-test-run: *** ERROR: ", 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";
|
||||
print STDERR _timestamp(), "####: ", join(" ", @_), "\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub mtr_verbose (@) {
|
||||
# Always print to log, print to screen only when --verbose is used
|
||||
_mtr_log("> ",@_);
|
||||
if ( $::opt_verbose )
|
||||
{
|
||||
print STDERR "> ",join(" ", @_),"\n";
|
||||
print STDERR _timestamp(), "> ",join(" ", @_),"\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub mtr_verbose_restart (@) {
|
||||
my ($server, @args)= @_;
|
||||
my $proc= $server->{proc};
|
||||
if ( $::opt_verbose_restart )
|
||||
{
|
||||
print STDERR _timestamp(), "> Restart $proc - ",join(" ", @args),"\n";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
@ -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();
|
||||
|
||||
@ -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;
|
||||
27
mysql-test/lib/t/Base.t
Normal file
27
mysql-test/lib/t/Base.t
Normal file
@ -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");
|
||||
}
|
||||
|
||||
33
mysql-test/lib/t/Find.t
Normal file
33
mysql-test/lib/t/Find.t
Normal file
@ -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";
|
||||
127
mysql-test/lib/t/Options.t
Normal file
127
mysql-test/lib/t/Options.t
Normal file
@ -0,0 +1,127 @@
|
||||
|
||||
# -*- cperl -*-
|
||||
use Test::More qw(no_plan);
|
||||
use strict;
|
||||
|
||||
use_ok("My::Options");
|
||||
|
||||
my @tests=
|
||||
(
|
||||
[
|
||||
['--binlog-format=row', '--loose-skip-innodb', '--binlog-format=ms'],
|
||||
['--binlog-format=row', '--loose-skip-innodb', '--binlog-format=statement'],
|
||||
['--binlog-format=statement']
|
||||
],
|
||||
|
||||
[
|
||||
['--binlog-format=row', '--loose-skip-innodb', '--binlog-format=statement'],
|
||||
['--binlog-format=row', '--loose-skip-innodb', '--binlog-format=mixed'],
|
||||
['--binlog-format=mixed']
|
||||
],
|
||||
|
||||
[
|
||||
['--binlog-format=row', '--loose-skip-innodb', '--binlog-format=mixed'],
|
||||
['--binlog-format=row', '--loose-skip-innodb', '--binlog-format=statement'],
|
||||
['--binlog-format=statement']
|
||||
],
|
||||
|
||||
[
|
||||
['--binlog-format=mixed', '--loose-skip-innodb', '--binlog-format=row'],
|
||||
['--binlog-format=statement', '--loose-skip-innodb', '--binlog-format=row'],
|
||||
[ ]
|
||||
],
|
||||
|
||||
[
|
||||
['--binlog-format=row'],
|
||||
[ ],
|
||||
['--binlog-format=default']
|
||||
],
|
||||
|
||||
[
|
||||
[ ],
|
||||
['--binlog-format=row'],
|
||||
['--binlog-format=row']
|
||||
],
|
||||
|
||||
[
|
||||
[ ],
|
||||
['-O', 'max_binlog_size=1' ],
|
||||
['--max_binlog_size=1' ]
|
||||
],
|
||||
|
||||
[
|
||||
['-O', 'max_binlog_size=1' ],
|
||||
['-O', 'max_binlog_size=1' ],
|
||||
[ ],
|
||||
],
|
||||
|
||||
[
|
||||
['-O', 'max_binlog_size=1' ],
|
||||
[ ],
|
||||
['--max_binlog_size=default' ]
|
||||
],
|
||||
|
||||
[
|
||||
[ ],
|
||||
['-O', 'max_binlog_size=1', '--binlog-format=row' ],
|
||||
['--max_binlog_size=1', '--binlog-format=row' ]
|
||||
],
|
||||
[
|
||||
['--binlog-format=statement' ],
|
||||
['-O', 'max_binlog_size=1', '--binlog-format=row' ],
|
||||
['--max_binlog_size=1', '--binlog-format=row']
|
||||
],
|
||||
|
||||
[
|
||||
[ '--binlog-format=statement' ],
|
||||
['-O', 'max_binlog_size=1', '--binlog-format=statement' ],
|
||||
['--max_binlog_size=1' ]
|
||||
],
|
||||
|
||||
[
|
||||
[ '--binlog-format=statement' ],
|
||||
['-O', 'max_binlog_size=1', '--binlog-format=statement' ],
|
||||
['--max_binlog_size=1' ]
|
||||
],
|
||||
|
||||
[
|
||||
[ '--binlog-format=statement' ],
|
||||
['--relay-log=/path/to/a/relay-log', '--binlog-format=row'],
|
||||
['--relay-log=/path/to/a/relay-log', '--binlog-format=row' ]
|
||||
],
|
||||
|
||||
|
||||
[
|
||||
[ '--binlog-format=statement' ],
|
||||
['--relay-log=/path/to/a/relay-log', '-O', 'max_binlog_size=1'],
|
||||
['--max_binlog_size=1', '--relay-log=/path/to/a/relay-log', '--binlog-format=default' ]
|
||||
],
|
||||
|
||||
[
|
||||
[ '--slow-query-log=0' ],
|
||||
[ '--slow-query-log' ],
|
||||
[ '--slow-query-log' ]
|
||||
],
|
||||
|
||||
|
||||
);
|
||||
|
||||
|
||||
my $test_no= 0;
|
||||
foreach my $test (@tests){
|
||||
print "test", $test_no++, "\n";
|
||||
foreach my $opts (@$test){
|
||||
print My::Options::toStr("", @$opts);
|
||||
}
|
||||
my $from= $test->[0];
|
||||
my $to= $test->[1];
|
||||
my @result= My::Options::diff($from, $to);
|
||||
ok(My::Options::same(\@result, $test->[2]));
|
||||
if (!My::Options::same(\@result, $test->[2])){
|
||||
print "failed\n";
|
||||
print My::Options::toStr("result", @result);
|
||||
print My::Options::toStr("expect", @{$test->[2]});
|
||||
}
|
||||
print My::Options::toSQL(@result), "\n";
|
||||
print "\n";
|
||||
}
|
||||
18
mysql-test/lib/t/Platform.t
Normal file
18
mysql-test/lib/t/Platform.t
Normal file
@ -0,0 +1,18 @@
|
||||
# -*- cperl -*-
|
||||
use Test::More qw(no_plan);
|
||||
use strict;
|
||||
|
||||
use_ok ("My::Platform");
|
||||
use My::Platform;
|
||||
|
||||
use File::Temp qw / tempdir /;
|
||||
my $dir = tempdir( CLEANUP => 1 );
|
||||
|
||||
print "Running on Windows\n" if (IS_WINDOWS);
|
||||
print "Using ActiveState perl\n" if (IS_WIN32PERL);
|
||||
print "Using cygwin perl\n" if (IS_CYGWIN);
|
||||
|
||||
print "dir: '$dir'\n";
|
||||
print "native: '".native_path($dir)."'\n";
|
||||
print "mixed: '".mixed_path($dir)."'\n";
|
||||
print "posix: '".posix_path($dir)."'\n";
|
||||
102
mysql-test/lib/t/SafeProcess.t
Normal file
102
mysql-test/lib/t/SafeProcess.t
Normal file
@ -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");
|
||||
|
||||
}
|
||||
149
mysql-test/lib/t/SafeProcessStress.pl
Executable file
149
mysql-test/lib/t/SafeProcessStress.pl
Executable file
@ -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= 100;
|
||||
|
||||
print "kill one and wait for one\n";
|
||||
for (1...$loops){
|
||||
use File::Temp qw / tempdir /;
|
||||
my $dir = tempdir( CLEANUP => 1 );
|
||||
|
||||
my @procs;
|
||||
for (1..10){
|
||||
|
||||
my $args= [ "$FindBin::Bin/dummyd.pl", "--vardir=$dir" ];
|
||||
my $proc= My::SafeProcess->new
|
||||
(
|
||||
path => $perl_path,
|
||||
args => \$args,
|
||||
verbose => $verbose,
|
||||
);
|
||||
push(@procs, $proc);
|
||||
}
|
||||
|
||||
foreach my $proc (@procs) {
|
||||
$proc->kill();
|
||||
# dummyd will always be killed and thus
|
||||
# exit_status should have been set to 1
|
||||
die "oops, exit_status: ", $proc->exit_status()
|
||||
unless $proc->exit_status() == 1;
|
||||
}
|
||||
|
||||
print "=" x 60, "\n";
|
||||
}
|
||||
|
||||
|
||||
print "With 1 second sleep in dummyd\n";
|
||||
for (1...$loops){
|
||||
use File::Temp qw / tempdir /;
|
||||
my $dir = tempdir( CLEANUP => 1 );
|
||||
|
||||
my @procs;
|
||||
for (1..10){
|
||||
|
||||
my $args= [ "$FindBin::Bin/dummyd.pl",
|
||||
"--vardir=$dir",
|
||||
"--sleep=1" ];
|
||||
my $proc= My::SafeProcess->new
|
||||
(
|
||||
path => $perl_path,
|
||||
args => \$args,
|
||||
verbose => $verbose,
|
||||
);
|
||||
push(@procs, $proc);
|
||||
}
|
||||
|
||||
foreach my $proc (@procs) {
|
||||
$proc->kill();
|
||||
}
|
||||
|
||||
print "=" x 60, "\n";
|
||||
}
|
||||
|
||||
print "kill all and wait for one\n";
|
||||
for (1...$loops){
|
||||
use File::Temp qw / tempdir /;
|
||||
my $dir = tempdir( CLEANUP => 1 );
|
||||
|
||||
my @procs;
|
||||
for (1..10){
|
||||
|
||||
my $args= [ "$FindBin::Bin/dummyd.pl", "--vardir=$dir" ];
|
||||
my $proc= My::SafeProcess->new
|
||||
(
|
||||
path => $perl_path,
|
||||
args => \$args,
|
||||
verbose => $verbose,
|
||||
);
|
||||
push(@procs, $proc);
|
||||
}
|
||||
|
||||
foreach my $proc (@procs) {
|
||||
$proc->start_kill();
|
||||
}
|
||||
|
||||
foreach my $proc (@procs) {
|
||||
$proc->wait_one();
|
||||
}
|
||||
|
||||
print "=" x 60, "\n";
|
||||
}
|
||||
|
||||
print "kill all using shutdown without callback\n";
|
||||
for (1...$loops){
|
||||
use File::Temp qw / tempdir /;
|
||||
my $dir = tempdir( CLEANUP => 1 );
|
||||
|
||||
my @procs;
|
||||
for (1..10){
|
||||
|
||||
my $args= [ "$FindBin::Bin/dummyd.pl", "--vardir=$dir" ];
|
||||
my $proc= My::SafeProcess->new
|
||||
(
|
||||
path => $perl_path,
|
||||
args => \$args,
|
||||
verbose => $verbose,
|
||||
);
|
||||
push(@procs, $proc);
|
||||
}
|
||||
|
||||
My::SafeProcess::shutdown(2, @procs);
|
||||
|
||||
print "=" x 60, "\n";
|
||||
}
|
||||
|
||||
print "kill all using shutdown\n";
|
||||
for (1...$loops){
|
||||
use File::Temp qw / tempdir /;
|
||||
my $dir = tempdir( CLEANUP => 1 );
|
||||
|
||||
my @procs;
|
||||
for (1..10){
|
||||
|
||||
my $args= [ "$FindBin::Bin/dummyd.pl", "--vardir=$dir" ];
|
||||
my $proc= My::SafeProcess->new
|
||||
(
|
||||
path => $perl_path,
|
||||
args => \$args,
|
||||
verbose => $verbose,
|
||||
shutdown => sub { }, # Does nothing
|
||||
);
|
||||
push(@procs, $proc);
|
||||
}
|
||||
|
||||
My::SafeProcess::shutdown(2, @procs);
|
||||
|
||||
print "=" x 60, "\n";
|
||||
}
|
||||
|
||||
exit(0);
|
||||
34
mysql-test/lib/t/copytree.t
Normal file
34
mysql-test/lib/t/copytree.t
Normal file
@ -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");
|
||||
|
||||
38
mysql-test/lib/t/dummyd.pl
Normal file
38
mysql-test/lib/t/dummyd.pl
Normal file
@ -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);
|
||||
|
||||
|
||||
52
mysql-test/lib/t/rmtree.t
Normal file
52
mysql-test/lib/t/rmtree.t
Normal file
@ -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");
|
||||
|
||||
131
mysql-test/lib/t/testMyConfig.t
Executable file
131
mysql-test/lib/t/testMyConfig.t
Executable file
@ -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";
|
||||
|
||||
98
mysql-test/lib/t/testMyConfigFactory.t
Executable file
98
mysql-test/lib/t/testMyConfigFactory.t
Executable file
@ -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");
|
||||
21
mysql-test/lib/t/test_child.pl
Executable file
21
mysql-test/lib/t/test_child.pl
Executable file
@ -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);
|
||||
|
||||
|
||||
Reference in New Issue
Block a user