1berry/MariaDB-server
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Merge

Browse Source
This commit is contained in:
Magnus Svensson 2008-10-08 22:30:56 +02:00
commit ce9f585b48
9 changed files with 152 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Makefile.am
View File

@ -121,6 +121,10 @@ test-reprepare:
test: test-unit test-ns test-pr
smoke:
cd mysql-test ; \
@PERL@ ./mysql-test-run.pl --do-test=s
test-full: test test-nr test-ps
test-force:

8
mysql-test/lib/My/CoreDump.pm
View File

@ -25,6 +25,8 @@ use File::Temp qw/ tempfile tempdir /;
sub _gdb {
my ($core_name)= @_;
print "\nTrying 'gdb' to get a backtrace\n";
return unless -f $core_name;
my $dir = tempdir( CLEANUP => 1 );
@ -35,7 +37,7 @@ sub _gdb {
"quit\n";
# Find out name of binary that generated core
my $list= `gdb -c $core_name -x $tmp_name -q --batch 2>&1`
my $list= `gdb -c $core_name -x $tmp_name -batch 2>&1`
or return;
my $binary;
@ -47,9 +49,9 @@ sub _gdb {
return unless $binary;
print "Generated by '$binary'\n";
print " - core generated by '$binary'\n";
my $list= `gdb $binary -c $core_name -x $tmp_name -q --batch 2>&1`
my $list= `gdb $binary -c $core_name -x $tmp_name -batch 2>&1`
or return;
print $list, "\n";

43
mysql-test/lib/My/File/Path.pm
View File

@ -20,33 +20,40 @@ 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';
use My::Handles;
sub rmtree {
my ($dir)= @_;
#
# chmod all files to 0777 before calling rmtree
#
find( {
no_chdir => 1,
bydepth => 1,
no_chdir => 1,
wanted => sub {
chmod(0777, $_)
or warn("couldn't chmod(0777, $_): $!");
my $name= $_;
if (!-l $name && -d _){
return if (rmdir($name) == 1);
chmod(0777, $name) or carp("couldn't chmod(0777, $name): $!");
return if (rmdir($name) == 1);
# Failed to remove the directory, analyze
carp("Couldn't remove directory '$name': $!");
My::Handles::show_handles($name);
} else {
return if (unlink($name) == 1);
chmod(0777, $name) or carp("couldn't chmod(0777, $name): $!");
return if (unlink($name) == 1);
carp("Couldn't delete file '$name': $!");
My::Handles::show_handles($name);
}
}
},
$dir
);
# Call rmtree from File::Path
goto &File::Path::rmtree;
}, $dir );
};

69
mysql-test/lib/My/Handles.pm Executable file
View File

@ -0,0 +1,69 @@
# -*- cperl -*-
# 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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
package My::Handles;
use strict;
use Carp;
use My::Platform;
my $handle_exe;
if (IS_WINDOWS){
# Check if handle.exe is available
# Pass switch to accept the EULA to avoid hanging
# if the program hasn't been run before.
my $list= `handle.exe -? -accepteula 2>&1`;
foreach my $line (split('\n', $list))
{
$handle_exe= "$1.$2"
if ($line =~ /Handle v([0-9]*)\.([0-9]*)/);
}
if ($handle_exe){
print "Found handle.exe version $handle_exe\n";
}
}
sub show_handles
{
my ($dir)= @_;
return unless $handle_exe;
return unless $dir;
$dir= native_path($dir);
# Get a list of open handles in a particular directory
my $list= `handle.exe "$dir" 2>&1` or return;
foreach my $line (split('\n', $list))
{
return if ($line =~ /No matching handles found/);
}
print "\n";
print "=" x 50, "\n";
print "Open handles in '$dir':\n";
print "$list\n";
print "=" x 50, "\n\n";
return;
}
1;

2
mysql-test/lib/My/Platform.pm
View File

@ -18,7 +18,7 @@ package My::Platform;
use strict;
use File::Basename;
use My::File::Path; # Patched version of File::Path
use File::Path; # Patched version of File::Path
use base qw(Exporter);
our @EXPORT= qw(IS_CYGWIN IS_WINDOWS IS_WIN32PERL

46
mysql-test/lib/My/SafeProcess.pm
View File

@ -66,7 +66,9 @@ END {
for my $proc (values %running){
if ( $proc->is_child($$) ){
#print "Killing: $proc\n";
$proc->kill();
if ($proc->wait_one(0)){
$proc->kill();
}
}
}
}
@ -146,7 +148,7 @@ sub new {
print "### safe_path: ", $safe_path, " ", join(" ", @safe_args), "\n"
if $verbose > 1;
my ($pid, $winpid)= create_process(
my $pid= create_process(
path => $safe_path,
input => $input,
output => $output,
@ -159,7 +161,7 @@ sub new {
my $proc= bless
({
SAFE_PID => $pid,
SAFE_WINPID => $winpid,
SAFE_WINPID => $pid, # Inidicates this is always a real process
SAFE_NAME => $name,
SAFE_SHUTDOWN => $shutdown,
PARENT => $$,
@ -302,6 +304,18 @@ sub shutdown {
}
sub _winpid ($) {
my ($pid)= @_;
# In win32 perl, the pid is already the winpid
return $pid unless IS_CYGWIN;
# In cygwin, the pid is the pseudo process ->
# get the real winpid of my_safe_process
return Cygwin::pid_to_winpid($pid);
}
#
# Tell the process to die as fast as possible
#
@ -311,22 +325,24 @@ sub start_kill {
_verbose("start_kill: $self");
my $ret= 1;
my $pid;
my $pid= $self->{SAFE_PID};
die "INTERNAL ERROR: no pid" unless defined $pid;
if (IS_WINDOWS and defined $self->{SAFE_WINPID})
{
die "INTERNAL ERROR: no safe_kill" unless defined $safe_kill;
die "INTERNAL ERROR: no winpid" unless defined $self->{SAFE_WINPID};
# Use my_safe_kill to tell my_safe_process
# it's time to kill it's child and return
$pid= $self->{SAFE_WINPID};
$ret= system($safe_kill, $pid) >> 8;
if (IS_CYGWIN and $ret == 3)
{
print "safe_process is gone, kickstart the fake process\n";
if (kill(15, $self->{SAFE_PID}) != 1){
print STDERR "Failed to kickstart the fake process\n";
}
my $winpid= _winpid($pid);
$ret= system($safe_kill, $winpid) >> 8;
if ($ret == 3){
print "Couldn't open the winpid: $winpid ",
"for pid: $pid, try one more time\n";
sleep(1);
$winpid= _winpid($pid);
$ret= system($safe_kill, $winpid) >> 8;
print "Couldn't open the winpid: $winpid ",
"for pid: $pid, continue and see what happens...\n";
}
}
else

28
mysql-test/lib/My/SafeProcess/Base.pm
View File

@ -33,30 +33,6 @@ 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
@ -179,7 +155,7 @@ sub create_process {
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;
return $pid;
}
@ -190,7 +166,7 @@ sub create_process {
# Parent
$pipe->reader();
my $line= <$pipe>; # Wait for child to say it's ready
return wantarray ? ($pid, winpid($pid)) : $pid;
return $pid;
}
$SIG{INT}= 'DEFAULT';

15
mysql-test/lib/My/SafeProcess/safe_kill_win.cc
View File

@ -49,12 +49,25 @@ int main(int argc, const char** argv )
while ((shutdown_event=
OpenEvent(EVENT_MODIFY_STATE, FALSE, safe_process_name)) == NULL)
{
/*
Check if the process is alive, otherwise there is really
no idea to retry the open of the event
*/
HANDLE process;
if ((process= OpenProcess(SYNCHRONIZE, FALSE, pid)) == NULL)
{
fprintf(stderr, "Could not open event or process %d, error: %d\n",
pid, GetLastError());
exit(3);
}
CloseHandle(process);
if (retry_open_event--)
Sleep(100);
else
{
fprintf(stderr, "Failed to open shutdown_event '%s', error: %d\n",
safe_process_name, GetLastError());
safe_process_name, GetLastError());
exit(3);
}
}

1
mysql-test/mysql-test-run.pl
View File

@ -4244,6 +4244,7 @@ sub start_check_testcase ($$$) {
error => $errfile,
args => \$args,
user_data => $errfile,
verbose => $opt_verbose,
);
mtr_report("Started $proc");