Below is the list of changes that have just been committed into a local
5.0 repository of msvensson. When msvensson does a push these changes will
be propagated to the main repository and, within 24 hours after the
push, to the public repository.
For information on how to access the public repository
see http://dev.mysql.com/doc/mysql/en/installing-source-tree.html
ChangeSet@stripped, 2007-09-17 09:51:01+02:00, msvensson@pilot.(none) +5 -0
++
mysql-test/lib/My/SafeProcess.pm@stripped, 2007-09-17 09:50:59+02:00, msvensson@pilot.(none) +2 -20
Merge "wait" and "is_running"
mysql-test/lib/My/SafeProcess/Base.pm@stripped, 2007-09-17 09:50:59+02:00, msvensson@pilot.(none) +15 -29
Use system(1, "command") to spawn processes
mysql-test/lib/My/SafeProcess/safe_process.pl@stripped, 2007-09-17 09:50:59+02:00, msvensson@pilot.(none) +78 -44
Reorg
mysql-test/lib/t/SafeProcess.t@stripped, 2007-09-17 09:50:59+02:00, msvensson@pilot.(none) +29 -7
Add more tests and don't run so many loops
mysql-test/mysql-test-run.pl@stripped, 2007-09-17 09:50:59+02:00, msvensson@pilot.(none) +24 -28
Improve wait loop
diff -Nrup a/mysql-test/lib/My/SafeProcess/Base.pm b/mysql-test/lib/My/SafeProcess/Base.pm
--- a/mysql-test/lib/My/SafeProcess/Base.pm 2007-09-14 14:52:57 +02:00
+++ b/mysql-test/lib/My/SafeProcess/Base.pm 2007-09-17 09:50:59 +02:00
@@ -32,20 +32,6 @@ use base qw(Exporter);
our @EXPORT= qw(create_process);
-BEGIN {
- #Check availability of Win32::Process
- if ($^O eq "MSWin32") {
- require Win32::Process;
- Win32::Process->import();
- print "Using Win32::Process\n";
- eval 'sub IS_WIN32PERL () { 1 }';
- }
- else {
- eval 'sub IS_WIN32PERL () { 0 }';
- }
-}
-
-
#
# safe_fork
# Retry a couple of times if fork returns EAGAIN
@@ -110,10 +96,7 @@ sub create_process {
my $output = delete($opts{'output'});
my $error = delete($opts{'error'});
- if (IS_WIN32PERL){
-
- $output= "NUL" if $output eq "/dev/null";
- $error= "NUL" if $error eq "/dev/null";
+ if ($^O eq "MSWin32"){
my $open_mode= $opts{append} ? ">>" : ">";
@@ -149,18 +132,21 @@ sub create_process {
}
}
- my $proc;
- if ( Win32::Process::Create($proc,
- $path,
- "$path " . join(" ",@$args),
- 1,
- NORMAL_PRIORITY_CLASS,
- ".") == 0) {
- print $olderr "CreateProcess failed: $^E\n";
- confess("CreateProcess failed: $^E");
- }
- my $pid= $proc->GetProcessID();
+ # Magic use of 'system(1, @args)' - spawns an external process and
+ # immediately returns its process designator, without waiting for it
+ # to terminate. Return value may be used subsequently in "wait" or
+ # "waitpid". Failure to spawn() a subprocess is indicated by setting
+ # $? to "255 << 8". $? is set in a way compatible with Unix (i.e. the
+ # exitstatus of the subprocess is obtained by "$? >> 8", as described
+ # in the documentation). (Win32)
+
+ 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
close STDERR;
diff -Nrup a/mysql-test/lib/My/SafeProcess/safe_process.pl b/mysql-test/lib/My/SafeProcess/safe_process.pl
--- a/mysql-test/lib/My/SafeProcess/safe_process.pl 2007-09-14 14:52:57 +02:00
+++ b/mysql-test/lib/My/SafeProcess/safe_process.pl 2007-09-17 09:50:59 +02:00
@@ -4,6 +4,7 @@
use strict;
use warnings;
+use Time::localtime;
use lib 'lib';
use My::SafeProcess::Base;
@@ -12,7 +13,6 @@ BEGIN {
if ($^O eq "MSWin32") {
require Win32::Process;
Win32::Process->import();
- print "Using Win32::Process\n";
eval 'sub IS_WIN32PERL () { 1 }';
}
else {
@@ -65,8 +65,8 @@ sub proc_kill {
{
# ActiveState code(win32.c) shows that a negative
# signal number _should_ kill the process and any childs
- $ret= kill(-9, $pid);
-
+ #$ret= kill(-9, $pid);
+ $ret= kill(9, $pid);
}
else
{
@@ -86,8 +86,10 @@ sub proc_kill {
#
# Wait for process to exit
-# Return >0 if the process exited
+# Return 1 if the process exited
+# and set exit_code
#
+my $exit_code;
sub proc_wait {
my ($pid, $timeout)= @_;
die "Usage: proc_wait(pid, timeout)"
@@ -96,7 +98,11 @@ sub proc_wait {
if (IS_WIN32PERL) {
my $proc;
Win32::Process::Open($proc, $pid, 0);
- return ($proc->Wait($timeout*1000) != 0);
+ if ($proc->Wait($timeout*1000) != 0) {
+ # Process has exited, collect return status
+ $proc->GetExitCode($exit_code);
+ return 1;
+ }
}
my $ret_pid;
@@ -107,21 +113,22 @@ sub proc_wait {
alarm(0);
};
if ($@){
- die "Unexpected; $@" unless ($@ =~ /got alarm timeout/);
+ die "Unexpected: $@" unless ($@ =~ /got alarm timeout/);
return 0;
}
- pe("proc_wait, ret_pid: $ret_pid");
- return ($ret_pid == $pid);
+ if ($ret_pid == $pid) {
+ # Process has exited, collect return status
+ $exit_code= $? >> 8;
+ return 1;
+ }
+
+ return 0;
}
-use Time::localtime;
sub timestamp {
- my $tm= localtime();
- return sprintf("%02d%02d%02d %2d:%02d:%02d",
- $tm->year % 100, $tm->mon+1, $tm->mday,
- $tm->hour, $tm->min, $tm->sec);
+
}
@@ -130,13 +137,17 @@ sub timestamp {
#
my $verbose= 0;
sub pe {
-
- print STDERR timestamp, " monitor[$$]: ", @_, "\n"
- if ($verbose > 0);
-
+ if ($verbose > 0){
+ my $tm= localtime();
+ my $timestamp= sprintf("%02d%02d%02d %2d:%02d:%02d",
+ $tm->year % 100, $tm->mon+1, $tm->mday,
+ $tm->hour, $tm->min, $tm->sec);
+ print STDERR $timestamp, " monitor[$$]: ", @_, "\n";
+ }
}
+
###########################################################################
# Main program
###########################################################################
@@ -144,7 +155,7 @@ sub pe {
my ($input, $output, $error, $append);
my $shutdown_timeout= 20;
-my $monitor_interval= 1;
+my $monitor_interval= 10;
use Getopt::Long;
Getopt::Long::Configure("pass_through");
@@ -187,36 +198,59 @@ my $child_pid= create_process(
);
pe("started child: $child_pid");
-my $terminated= 0;
-my $shutdown= 0;
-
-# SIGTERM cause hard kill of child
-$SIG{TERM}= sub {
- pe("Got SIGTERM");
- $terminated= 1;
-};
-# SIGINT causes "nice" kill of child
-$SIG{INT}= sub {
- pe("Got SIGINT");
- $terminated= 1;
- $shutdown=1;
-};
+$SIG{TERM}= 'IGNORE';
+$SIG{INT}= 'IGNORE';
+$SIG{BREAK}= 'IGNORE' if exists($SIG{BREAK});
+
+sub hardkill_signaled {
+ pe("Got $_[0] signal => hardkill");
+ die "hardkill\n";
+}
+sub shutdown_signaled {
+ pe("Got $_[0] signal => shutdown");
+ die "shutdown\n";
+}
-# Monitoring loop
-while(!$terminated) {
- pe("alive");
-
- if (!is_alive($parent_pid)){
- pe("parent is not alive");
- last;
+my $terminated= 0;
+my $shutdown= 0;
+eval {
+ # SIGTERM cause hard kill of child
+ local $SIG{TERM}= \&hardkill_signaled;
+
+ # SIGINT causes "nice" kill of child
+ local $SIG{INT}= \&shutdown_signaled;
+
+ if ( exists($SIG{BREAK}) ) {
+ # Win32 perl uses SIGBREAK
+ local $SIG{BREAK}= \&shutdown_signaled;
}
- # Wait for child to terminate
- if (proc_wait($child_pid, $monitor_interval)){
- pe("child has exited");
- last;
+ # Monitoring loop
+ while(!$terminated) {
+ pe("alive");
+
+ if (!is_alive($parent_pid)){
+ pe("parent is not alive");
+ last;
+ }
+
+ # Wait for child to terminate
+ if (proc_wait($child_pid, $monitor_interval)){
+ pe("child has exited");
+ last;
+ }
+ }
+};
+if ( $@ ) {
+ if ( $@ =~ /hardkill/ ) {
+ $terminated= 1;
+ } elsif ( $@ =~ /shutdown/ ) {
+ $terminated= 1;
+ $shutdown= 1;
+ } else {
+ die "Unexpected: $@";
}
}
@@ -237,6 +271,6 @@ proc_kill($child_pid) and
pe("DONE!");
# Exit from monitor with exit status of the child
-exit ($? >> 8);
+exit ($exit_code);
diff -Nrup a/mysql-test/lib/My/SafeProcess.pm b/mysql-test/lib/My/SafeProcess.pm
--- a/mysql-test/lib/My/SafeProcess.pm 2007-09-14 15:49:38 +02:00
+++ b/mysql-test/lib/My/SafeProcess.pm 2007-09-17 09:50:59 +02:00
@@ -204,27 +204,9 @@ sub wait {
sub is_running {
my ($self)= @_;
- # No pid => not running
- return 0 unless defined $self->{MONITOR_PID};
+ my $ret= $self->wait(0);
- # Exit status already set => not running
- return 0 if defined $self->{EXIT_STATUS};
-
- my $pid= $self->{MONITOR_PID};
- my $retpid= waitpid($pid, &WNOHANG );
-
- # -1 => not running
- return 0 if ($retpid == -1);
-
- # 0 => still running
- return 1 if ($retpid == 0);
-
- die("wait: expected pid $pid but got $retpid")
- unless( $retpid == $pid );
-
- $self->_collect();
-
- return 0;
+ return $ret;
}
diff -Nrup a/mysql-test/lib/t/SafeProcess.t b/mysql-test/lib/t/SafeProcess.t
--- a/mysql-test/lib/t/SafeProcess.t 2007-09-14 14:52:57 +02:00
+++ b/mysql-test/lib/t/SafeProcess.t 2007-09-17 09:50:59 +02:00
@@ -11,12 +11,33 @@ use_ok ("My::SafeProcess");
{
- #
# Test exit codes
- # and that we can spawn a number of concurrent processes
- my $count= 255;
+ 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 => "$Config{perlpath}",
+ args => \$args,
+ output => "/dev/null",
+ error => "/dev/null",
+ );
+ # Wait max 10 seconds for the process to finish
+ $ok_count++ if ($proc->wait(10) 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) {
+ for my $code (0..$count-1) {
my $args= [ "$FindBin::Bin/test_child.pl", "--exit-code=$code" ];
$procs{$code}= My::SafeProcess->new
@@ -28,10 +49,11 @@ use_ok ("My::SafeProcess");
);
}
- for my $code (0..$count) {
- $procs{$code}->wait(5); # Wait max 5 seconds for the process to finish
- ok($procs{$code}->exit_status() == $code, "Check exit_code $code");
+ for my $code (0..$count-1) {
+ $ok_count++ if ($procs{$code}->wait(10) and
+ $procs{$code}->exit_status() == $code);
}
+ ok($count == $ok_count, "concurrent, $ok_count");
}
diff -Nrup a/mysql-test/mysql-test-run.pl b/mysql-test/mysql-test-run.pl
--- a/mysql-test/mysql-test-run.pl 2007-09-14 14:52:57 +02:00
+++ b/mysql-test/mysql-test-run.pl 2007-09-17 09:50:59 +02:00
@@ -135,7 +135,7 @@ our $opt_usage;
our $opt_suite;
our $opt_script_debug= 0; # Script debugging, enable with --script-debug
-our $opt_verbose= 1; # Verbose output, enable with --verbose
+our $opt_verbose= 0; # Verbose output, enable with --verbose
our $exe_master_mysqld;
our $exe_mysql;
@@ -3344,43 +3344,29 @@ sub run_testcase ($) {
{
do_before_run_mysqltest($tinfo);
- my $test_proc= start_mysqltest($tinfo);
my $res= 0;
+ my $test= start_mysqltest($tinfo);
while (1) {
- # Wait for any process to exit
- eval {
- # Install SIGHLD handler to break the wait if any
- # child exits
- local $SIG{CHLD}= sub { die "Got child termination"; };
- sleep(1);
- };
-
- # Has test exited
- mtr_verbose("Checking mysqltest, $test_proc");
- if (!$test_proc->wait(0))
+ # Wait for test process to exit
+ if (!$test->wait(1))
{
- $res= $test_proc->exit_status();
+ $res= $test->exit_status();
last;
}
- foreach my $server (@{$master}, @{$slave}, @{$clusters},
- map { @{$_->{'ndbds'}} } @{$clusters})
+ foreach my $server (started_servers())
{
- if (defined $server->{proc})
+ my $proc= $server->{proc};
+ if (!$proc->wait(0))
{
- my $proc= $server->{proc};
- mtr_verbose("Checking server, $proc");
- if (!$proc->wait(0))
- {
- $res= 64; # Servers failed during test run
- last;
- }
+ $res= 64; # Servers failed during test run
+ last;
}
}
+
last if $res;
}
-
mtr_report_test_name($tinfo);
if ( $res == 0 )
{
@@ -3874,6 +3860,10 @@ sub mysqld_arguments ($$$$) {
mtr_add_arg($args, "%s--open-files-limit=1024", $prefix);
}
+ if ( $glob_win32 ){
+ mtr_add_arg($args, "%s--log-error=$mysqld->{path_myerr}", $prefix);
+ }
+
return $args;
}
@@ -3994,8 +3984,7 @@ sub stop_all_servers () {
}
# Build list of servers to kill
- my @servers= (@{$master}, @{$slave}, @{$clusters},
- map { @{$_->{'ndbds'}} } @{$clusters});
+ my @servers= started_servers();
start_kill_servers( @servers );
wait_for_servers( @servers );
@@ -4166,6 +4155,13 @@ sub start_kill_servers {
}
+sub started_servers {
+ return grep { defined $_->{proc} }
+ (@{$master}, @{$slave}, @{$clusters},
+ map { @{$_->{'ndbds'}} } @{$clusters});
+}
+
+
sub run_testcase_stop_servers($$$) {
my ($tinfo, $do_restart, $do_slave_restart)= @_;
@@ -4446,7 +4442,7 @@ sub run_report_features () {
}
-sub run_mysqltest {
+sub run_mysqltest ($) {
my $proc= start_mysqltest(@_);
$proc->wait();
}
| Thread |
|---|
| • bk commit into 5.0 tree (msvensson:1.2528) | msvensson | 17 Sep |
