mirror of
https://github.com/MariaDB/server.git
synced 2025-07-02 14:22:51 +03:00
merge from 5.1-mtr
This commit is contained in:
Bjorn Munch
@ -22,6 +22,33 @@ use My::Platform;
|
||||
|
||||
use File::Temp qw/ tempfile tempdir /;
|
||||
|
||||
my $hint_mysqld; # Last resort guess for executable path
|
||||
|
||||
# If path in core file is 79 chars we assume it's been truncated
|
||||
# Looks like we can still find the full path using 'strings'
|
||||
# If that doesn't work, use the hint (mysqld path) as last resort.
|
||||
|
||||
sub _verify_binpath {
|
||||
my ($binary, $core_name)= @_;
|
||||
my $binpath;
|
||||
|
||||
if (length $binary != 79) {
|
||||
$binpath= $binary;
|
||||
print "Core generated by '$binpath'\n";
|
||||
} else {
|
||||
# Last occurrence of path ending in /mysql*, cut from first /
|
||||
if (`strings '$core_name' | grep "/mysql[^/. ]*\$" | tail -1` =~ /(\/.*)/) {
|
||||
$binpath= $1;
|
||||
print "Guessing that core was generated by '$binpath'\n";
|
||||
} else {
|
||||
return unless $hint_mysqld;
|
||||
$binpath= $hint_mysqld;
|
||||
print "Wild guess that core was generated by '$binpath'\n";
|
||||
}
|
||||
}
|
||||
return $binpath;
|
||||
}
|
||||
|
||||
sub _gdb {
|
||||
my ($core_name)= @_;
|
||||
|
||||
@ -33,7 +60,8 @@ sub _gdb {
|
||||
`gdb -c '$core_name' --batch 2>&1` =~
|
||||
/Core was generated by `([^\s\'\`]+)/;
|
||||
my $binary= $1 or return;
|
||||
print "Core generated by '$binary'\n";
|
||||
|
||||
$binary= _verify_binpath ($binary, $core_name) or return;
|
||||
|
||||
# Create tempfile containing gdb commands
|
||||
my ($tmp, $tmp_name) = tempfile();
|
||||
@ -73,7 +101,8 @@ sub _dbx {
|
||||
`echo | dbx - '$core_name' 2>&1` =~
|
||||
/Corefile specified executable: "([^"]+)"/;
|
||||
my $binary= $1 or return;
|
||||
print "Core generated by '$binary'\n";
|
||||
|
||||
$binary= _verify_binpath ($binary, $core_name) or return;
|
||||
|
||||
# Find all threads
|
||||
my @thr_ids = `echo threads | dbx '$binary' '$core_name' 2>&1` =~ /t@\d+/g;
|
||||
@ -203,7 +232,7 @@ sub _cdb {
|
||||
|
||||
my $cdb_cmd = "!sym prompts off; !analyze -v; .ecxr; !for_each_frame dv /t;!uniqstack -p;q";
|
||||
my $cdb_output=
|
||||
`cdb -z $core_name -i "$image_path" -y "$symbol_path" -t 0 -lines -c "$cdb_cmd" 2>&1`;
|
||||
`cdb -c "$cdb_cmd" -z $core_name -i "$image_path" -y "$symbol_path" -t 0 -lines 2>&1`;
|
||||
return if $? >> 8;
|
||||
return unless $cdb_output;
|
||||
|
||||
@ -225,7 +254,8 @@ EOF
|
||||
|
||||
|
||||
sub show {
|
||||
my ($class, $core_name)= @_;
|
||||
my ($class, $core_name, $exe_mysqld)= @_;
|
||||
$hint_mysqld= $exe_mysqld;
|
||||
|
||||
# On Windows, rely on cdb to be there...
|
||||
if (IS_WINDOWS)
|
||||
|
||||
@ -164,6 +164,9 @@ sub copytree {
|
||||
copytree("$from_dir/$_", "$to_dir/$_");
|
||||
next;
|
||||
}
|
||||
|
||||
# Only copy plain files
|
||||
next unless -f "$from_dir/$_";
|
||||
copy("$from_dir/$_", "$to_dir/$_");
|
||||
}
|
||||
closedir(DIR);
|
||||
|
||||
@ -536,7 +536,37 @@ sub wait_any {
|
||||
return $proc;
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# Wait for all processes to exit
|
||||
#
|
||||
sub wait_all {
|
||||
while(keys %running)
|
||||
{
|
||||
wait_any();
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# Check if any process has exited, but don't wait.
|
||||
#
|
||||
# Returns a reference to the SafeProcess that
|
||||
# exited or undefined
|
||||
#
|
||||
sub check_any {
|
||||
for my $proc (values %running){
|
||||
if ( $proc->is_child($$) ) {
|
||||
if (not $proc->wait_one(0)) {
|
||||
_verbose ("Found exited $proc");
|
||||
return $proc;
|
||||
}
|
||||
}
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
|
||||
# Overload string operator
|
||||
# and fallback to default functions if no
|
||||
# overloaded function is found
|
||||
|
||||
@ -83,6 +83,13 @@ sub exit_status {
|
||||
};
|
||||
}
|
||||
|
||||
# threads.pm may not exist everywhere, so use only on Windows.
|
||||
|
||||
use if $^O eq "MSWin32", "threads";
|
||||
use if $^O eq "MSWin32", "threads::shared";
|
||||
|
||||
my $win32_spawn_lock :shared;
|
||||
|
||||
|
||||
#
|
||||
# Create a new process
|
||||
@ -104,6 +111,8 @@ sub create_process {
|
||||
|
||||
if ($^O eq "MSWin32"){
|
||||
|
||||
lock($win32_spawn_lock);
|
||||
|
||||
#printf STDERR "stdin %d, stdout %d, stderr %d\n",
|
||||
# fileno STDIN, fileno STDOUT, fileno STDERR;
|
||||
|
||||
|
||||
@ -259,22 +259,37 @@ int main(int argc, const char** argv )
|
||||
the JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE flag, making sure it will be
|
||||
terminated when the last handle to it is closed(which is owned by
|
||||
this process).
|
||||
|
||||
If breakaway from job fails on some reason, fallback is to create a
|
||||
new process group. Process groups also allow to kill process and its
|
||||
descedants, subject to some restrictions (processes have to run within
|
||||
the same console,and must not ignore CTRL_BREAK)
|
||||
*/
|
||||
if (CreateProcess(NULL, (LPSTR)child_args,
|
||||
DWORD create_flags[]= {CREATE_BREAKAWAY_FROM_JOB, CREATE_NEW_PROCESS_GROUP, 0};
|
||||
BOOL process_created= FALSE;
|
||||
BOOL jobobject_assigned= FALSE;
|
||||
|
||||
for (int i=0; i < sizeof(create_flags)/sizeof(create_flags[0]); i++)
|
||||
{
|
||||
process_created= CreateProcess(NULL, (LPSTR)child_args,
|
||||
NULL,
|
||||
NULL,
|
||||
TRUE, /* inherit handles */
|
||||
CREATE_SUSPENDED | CREATE_BREAKAWAY_FROM_JOB,
|
||||
CREATE_SUSPENDED | create_flags[i],
|
||||
NULL,
|
||||
NULL,
|
||||
&si,
|
||||
&process_info) == 0)
|
||||
die("CreateProcess failed");
|
||||
&process_info);
|
||||
if (process_created)
|
||||
{
|
||||
jobobject_assigned= AssignProcessToJobObject(job_handle, process_info.hProcess);
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
if (AssignProcessToJobObject(job_handle, process_info.hProcess) == 0)
|
||||
if (!process_created)
|
||||
{
|
||||
TerminateProcess(process_info.hProcess, 200);
|
||||
die("AssignProcessToJobObject failed");
|
||||
die("CreateProcess failed");
|
||||
}
|
||||
ResumeThread(process_info.hThread);
|
||||
CloseHandle(process_info.hThread);
|
||||
@ -312,6 +327,13 @@ int main(int argc, const char** argv )
|
||||
message("TerminateJobObject failed");
|
||||
CloseHandle(job_handle);
|
||||
message("Job terminated and closed");
|
||||
|
||||
if (!jobobject_assigned)
|
||||
{
|
||||
GenerateConsoleCtrlEvent(CTRL_BREAK_EVENT, process_info.dwProcessId);
|
||||
TerminateProcess(process_info.hProcess, 202);
|
||||
}
|
||||
|
||||
if (wait_res != WAIT_OBJECT_0 + CHILD)
|
||||
{
|
||||
/* The child has not yet returned, wait for it */
|
||||
|
||||
@ -33,7 +33,7 @@ our $print_testcases;
|
||||
our $skip_rpl;
|
||||
our $do_test;
|
||||
our $skip_test;
|
||||
our $opt_skip_combination;
|
||||
our $skip_combinations;
|
||||
our $binlog_format;
|
||||
our $enable_disabled;
|
||||
our $default_storage_engine;
|
||||
@ -119,11 +119,22 @@ sub collect_test_cases ($$) {
|
||||
if ( $test->{name} =~ /.*\.$tname/ )
|
||||
{
|
||||
$found= 1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
if ( not $found )
|
||||
{
|
||||
mtr_error("Could not find '$tname' in '$suites' suite(s)");
|
||||
mtr_error("Could not find '$tname' in '$suites' suite(s)") unless $sname;
|
||||
# If suite was part of name, find it there
|
||||
my ($this_case) = collect_one_suite($sname, [ $tname ]);
|
||||
if ($this_case)
|
||||
{
|
||||
push (@$cases, $this_case);
|
||||
}
|
||||
else
|
||||
{
|
||||
mtr_error("Could not find '$tname' in '$sname' suite");
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
@ -375,7 +386,7 @@ sub collect_one_suite($)
|
||||
# Read combinations for this suite and build testcases x combinations
|
||||
# if any combinations exists
|
||||
# ----------------------------------------------------------------------
|
||||
if ( ! $opt_skip_combination )
|
||||
if ( ! $skip_combinations )
|
||||
{
|
||||
my @combinations;
|
||||
my $combination_file= "$suitedir/combinations";
|
||||
|
||||
@ -21,7 +21,25 @@
|
||||
use strict;
|
||||
use Socket;
|
||||
use Errno;
|
||||
use My::Platform;
|
||||
use if IS_WINDOWS, "Net::Ping";
|
||||
|
||||
# Ancient perl might not have port_number method for Net::Ping.
|
||||
# Check it and use fallback to connect() if it is not present.
|
||||
BEGIN
|
||||
{
|
||||
my $use_netping= 0;
|
||||
if (IS_WINDOWS)
|
||||
{
|
||||
my $ping = Net::Ping->new();
|
||||
if ($ping->can("port_number"))
|
||||
{
|
||||
$use_netping= 1;
|
||||
}
|
||||
}
|
||||
eval 'sub USE_NETPING { $use_netping }';
|
||||
}
|
||||
|
||||
sub sleep_until_file_created ($$$);
|
||||
sub mtr_ping_port ($);
|
||||
|
||||
@ -30,6 +48,24 @@ sub mtr_ping_port ($) {
|
||||
|
||||
mtr_verbose("mtr_ping_port: $port");
|
||||
|
||||
if (IS_WINDOWS && USE_NETPING)
|
||||
{
|
||||
# Under Windows, connect to a port that is not open is slow
|
||||
# It takes ~1sec. Net::Ping with small timeout is much faster.
|
||||
my $ping = Net::Ping->new();
|
||||
$ping->port_number($port);
|
||||
if ($ping->ping("localhost",0.1))
|
||||
{
|
||||
mtr_verbose("USED");
|
||||
return 1;
|
||||
}
|
||||
else
|
||||
{
|
||||
mtr_verbose("FREE");
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
my $remote= "localhost";
|
||||
my $iaddr= inet_aton($remote);
|
||||
if ( ! $iaddr )
|
||||
|
||||
@ -30,6 +30,8 @@ our @EXPORT= qw(report_option mtr_print_line mtr_print_thick_line
|
||||
mtr_report_test);
|
||||
|
||||
use mtr_match;
|
||||
use My::Platform;
|
||||
use POSIX qw[ _exit ];
|
||||
require "mtr_io.pl";
|
||||
|
||||
my $tot_real_time= 0;
|
||||
@ -257,6 +259,17 @@ sub mtr_report_stats ($) {
|
||||
$tot_restarts++;
|
||||
}
|
||||
|
||||
# Add counts for repeated runs, if any.
|
||||
# Note that the last run has already been counted above.
|
||||
my $num_repeat = $tinfo->{'repeat'} - 1;
|
||||
if ( $num_repeat > 0 )
|
||||
{
|
||||
$tot_tests += $num_repeat;
|
||||
my $rep_failed = $tinfo->{'rep_failures'} || 0;
|
||||
$tot_failed += $rep_failed;
|
||||
$tot_passed += $num_repeat - $rep_failed;
|
||||
}
|
||||
|
||||
# Look for warnings produced by mysqltest
|
||||
my $base_file= mtr_match_extension($tinfo->{'result_file'},
|
||||
"result"); # Trim extension
|
||||
@ -336,7 +349,7 @@ sub mtr_report_stats ($) {
|
||||
foreach my $tinfo (@$tests)
|
||||
{
|
||||
my $tname= $tinfo->{'name'};
|
||||
if ( $tinfo->{failures} and ! $seen{$tname})
|
||||
if ( ($tinfo->{failures} || $tinfo->{rep_failures}) and ! $seen{$tname})
|
||||
{
|
||||
print " $tname";
|
||||
$seen{$tname}= 1;
|
||||
@ -459,7 +472,14 @@ sub mtr_warning (@) {
|
||||
sub mtr_error (@) {
|
||||
print STDERR _name(), _timestamp(),
|
||||
"mysql-test-run: *** ERROR: ", join(" ", @_), "\n";
|
||||
exit(1);
|
||||
if (IS_WINDOWS)
|
||||
{
|
||||
POSIX::_exit(1);
|
||||
}
|
||||
else
|
||||
{
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
@ -28,32 +28,36 @@ sub msg {
|
||||
# print "### unique($$) - ", join(" ", @_), "\n";
|
||||
}
|
||||
|
||||
my $file;
|
||||
my $dir;
|
||||
|
||||
if(!IS_WINDOWS)
|
||||
{
|
||||
$file= "/tmp/mysql-test-ports";
|
||||
$dir= "/tmp/mysql-unique-ids";
|
||||
}
|
||||
else
|
||||
{
|
||||
$file= $ENV{'TEMP'}."/mysql-test-ports";
|
||||
}
|
||||
|
||||
|
||||
my %mtr_unique_ids;
|
||||
|
||||
END {
|
||||
my $allocated_id= $mtr_unique_ids{$$};
|
||||
if (defined $allocated_id)
|
||||
# Try to use machine-wide directory location for unique IDs,
|
||||
# $ALLUSERSPROFILE . IF it is not available, fallback to $TEMP
|
||||
# which is typically a per-user temporary directory
|
||||
if (exists $ENV{'ALLUSERSPROFILE'} && -w $ENV{'ALLUSERSPROFILE'})
|
||||
{
|
||||
mtr_release_unique_id($allocated_id);
|
||||
$dir= $ENV{'ALLUSERSPROFILE'}."/mysql-unique-ids";
|
||||
}
|
||||
delete $mtr_unique_ids{$$};
|
||||
else
|
||||
{
|
||||
$dir= $ENV{'TEMP'}."/mysql-unique-ids";
|
||||
}
|
||||
}
|
||||
|
||||
my $mtr_unique_fh = undef;
|
||||
|
||||
END
|
||||
{
|
||||
mtr_release_unique_id();
|
||||
}
|
||||
|
||||
#
|
||||
# Get a unique, numerical ID, given a file name (where all
|
||||
# requested IDs are stored), a minimum and a maximum value.
|
||||
# Get a unique, numerical ID in a specified range.
|
||||
#
|
||||
# If no unique ID within the specified parameters can be
|
||||
# obtained, return undef.
|
||||
@ -61,135 +65,63 @@ END {
|
||||
sub mtr_get_unique_id($$) {
|
||||
my ($min, $max)= @_;;
|
||||
|
||||
msg("get, '$file', $min-$max");
|
||||
msg("get $min-$max, $$");
|
||||
|
||||
die "Can only get one unique id per process!" if $mtr_unique_ids{$$};
|
||||
die "Can only get one unique id per process!" if defined $mtr_unique_fh;
|
||||
|
||||
my $ret = undef;
|
||||
my $changed = 0;
|
||||
|
||||
if(eval("readlink '$file'") || eval("readlink '$file.sem'")) {
|
||||
die 'lock file is a symbolic link';
|
||||
}
|
||||
# Make sure our ID directory exists
|
||||
if (! -d $dir)
|
||||
{
|
||||
# If there is a file with the reserved
|
||||
# directory name, just delete the file.
|
||||
if (-e $dir)
|
||||
{
|
||||
unlink($dir);
|
||||
}
|
||||
|
||||
chmod 0777, "$file.sem";
|
||||
open SEM, ">", "$file.sem" or die "can't write to $file.sem";
|
||||
flock SEM, LOCK_EX or die "can't lock $file.sem";
|
||||
if(! -e $file) {
|
||||
open FILE, ">", $file or die "can't create $file";
|
||||
close FILE;
|
||||
}
|
||||
mkdir $dir;
|
||||
chmod 0777, $dir;
|
||||
|
||||
msg("HAVE THE LOCK");
|
||||
|
||||
if(eval("readlink '$file'") || eval("readlink '$file.sem'")) {
|
||||
die 'lock file is a symbolic link';
|
||||
}
|
||||
|
||||
chmod 0777, $file;
|
||||
open FILE, "+<", $file or die "can't open $file";
|
||||
#select undef,undef,undef,0.2;
|
||||
seek FILE, 0, 0;
|
||||
my %taken = ();
|
||||
while(<FILE>) {
|
||||
chomp;
|
||||
my ($id, $pid) = split / /;
|
||||
$taken{$id} = $pid;
|
||||
msg("taken: $id, $pid");
|
||||
# Check if process with given pid is alive
|
||||
if(!process_alive($pid)) {
|
||||
print "Removing slot $id used by missing process $pid\n";
|
||||
msg("Removing slot $id used by missing process $pid");
|
||||
delete $taken{$id};
|
||||
$changed++;
|
||||
if(! -d $dir)
|
||||
{
|
||||
die "can't make directory $dir";
|
||||
}
|
||||
}
|
||||
for(my $i=$min; $i<=$max; ++$i) {
|
||||
if(! exists $taken{$i}) {
|
||||
$ret = $i;
|
||||
$taken{$i} = $$;
|
||||
$changed++;
|
||||
# Remember the id this process got
|
||||
$mtr_unique_ids{$$}= $i;
|
||||
msg(" got $i");
|
||||
last;
|
||||
|
||||
|
||||
my $fh;
|
||||
for(my $id = $min; $id <= $max; $id++)
|
||||
{
|
||||
open( $fh, ">$dir/$id");
|
||||
chmod 0666, "$dir/$id";
|
||||
# Try to lock the file exclusively. If lock succeeds, we're done.
|
||||
if (flock($fh, LOCK_EX|LOCK_NB))
|
||||
{
|
||||
# Store file handle - we would need it to release the ID (==unlock the file)
|
||||
$mtr_unique_fh = $fh;
|
||||
return $id;
|
||||
}
|
||||
else
|
||||
{
|
||||
close $fh;
|
||||
}
|
||||
}
|
||||
if($changed) {
|
||||
seek FILE, 0, 0;
|
||||
truncate FILE, 0 or die "can't truncate $file";
|
||||
for my $k (keys %taken) {
|
||||
print FILE $k . ' ' . $taken{$k} . "\n";
|
||||
}
|
||||
}
|
||||
close FILE;
|
||||
|
||||
msg("RELEASING THE LOCK");
|
||||
flock SEM, LOCK_UN or warn "can't unlock $file.sem";
|
||||
close SEM;
|
||||
|
||||
return $ret;
|
||||
return undef;
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# Release a unique ID.
|
||||
#
|
||||
sub mtr_release_unique_id($) {
|
||||
my ($myid)= @_;
|
||||
|
||||
msg("release, $myid");
|
||||
|
||||
|
||||
if(eval("readlink '$file'") || eval("readlink '$file.sem'")) {
|
||||
die 'lock file is a symbolic link';
|
||||
}
|
||||
|
||||
open SEM, ">", "$file.sem" or die "can't write to $file.sem";
|
||||
flock SEM, LOCK_EX or die "can't lock $file.sem";
|
||||
|
||||
msg("HAVE THE LOCK");
|
||||
|
||||
if(eval("readlink '$file'") || eval("readlink '$file.sem'")) {
|
||||
die 'lock file is a symbolic link';
|
||||
}
|
||||
|
||||
if(! -e $file) {
|
||||
open FILE, ">", $file or die "can't create $file";
|
||||
close FILE;
|
||||
}
|
||||
open FILE, "+<", $file or die "can't open $file";
|
||||
#select undef,undef,undef,0.2;
|
||||
seek FILE, 0, 0;
|
||||
my %taken = ();
|
||||
while(<FILE>) {
|
||||
chomp;
|
||||
my ($id, $pid) = split / /;
|
||||
msg(" taken, $id $pid");
|
||||
$taken{$id} = $pid;
|
||||
}
|
||||
|
||||
if ($taken{$myid} != $$)
|
||||
sub mtr_release_unique_id()
|
||||
{
|
||||
msg("release $$");
|
||||
if (defined $mtr_unique_fh)
|
||||
{
|
||||
msg(" The unique id for this process does not match pid");
|
||||
close $mtr_unique_fh;
|
||||
$mtr_unique_fh = undef;
|
||||
}
|
||||
|
||||
|
||||
msg(" removing $myid");
|
||||
delete $taken{$myid};
|
||||
seek FILE, 0, 0;
|
||||
truncate FILE, 0 or die "can't truncate $file";
|
||||
for my $k (keys %taken) {
|
||||
print FILE $k . ' ' . $taken{$k} . "\n";
|
||||
}
|
||||
close FILE;
|
||||
|
||||
msg("RELEASE THE LOCK");
|
||||
|
||||
flock SEM, LOCK_UN or warn "can't unlock $file.sem";
|
||||
close SEM;
|
||||
|
||||
delete $mtr_unique_ids{$$};
|
||||
}
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user