merge from 5.1-mtr

9 files changed, 235 insertions, 142 deletions

diff --git a/mysql-test/lib/My/CoreDump.pm b/mysql-test/lib/My/CoreDump.pm
index f3e9f521384..3ac9e385070 100644
--- a/mysql-test/lib/My/CoreDump.pm
+++ b/mysql-test/lib/My/CoreDump.pm
@@ -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)
diff --git a/mysql-test/lib/My/File/Path.pm b/mysql-test/lib/My/File/Path.pm
index 99edeecdaf7..25a26568eee 100644
--- a/mysql-test/lib/My/File/Path.pm
+++ b/mysql-test/lib/My/File/Path.pm
@@ -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);
diff --git a/mysql-test/lib/My/SafeProcess.pm b/mysql-test/lib/My/SafeProcess.pm
index 5ef3286ad8e..7e102b628ca 100644
--- a/mysql-test/lib/My/SafeProcess.pm
+++ b/mysql-test/lib/My/SafeProcess.pm
@@ -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
diff --git a/mysql-test/lib/My/SafeProcess/Base.pm b/mysql-test/lib/My/SafeProcess/Base.pm
index 3fc1b1be017..9a6871264b8 100644
--- a/mysql-test/lib/My/SafeProcess/Base.pm
+++ b/mysql-test/lib/My/SafeProcess/Base.pm
@@ -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;
 
diff --git a/mysql-test/lib/My/SafeProcess/safe_process_win.cc b/mysql-test/lib/My/SafeProcess/safe_process_win.cc
index 4fb89f098ed..80c1b7a97f2 100755
--- a/mysql-test/lib/My/SafeProcess/safe_process_win.cc
+++ b/mysql-test/lib/My/SafeProcess/safe_process_win.cc
@@ -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 */
diff --git a/mysql-test/lib/mtr_cases.pm b/mysql-test/lib/mtr_cases.pm
index ae4fddae0a9..2a7b07debd0 100644
--- a/mysql-test/lib/mtr_cases.pm
+++ b/mysql-test/lib/mtr_cases.pm
@@ -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";
diff --git a/mysql-test/lib/mtr_process.pl b/mysql-test/lib/mtr_process.pl
index a99119a199d..a42627c93cd 100644
--- a/mysql-test/lib/mtr_process.pl
+++ b/mysql-test/lib/mtr_process.pl
@@ -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 )
diff --git a/mysql-test/lib/mtr_report.pm b/mysql-test/lib/mtr_report.pm
index 9c6ab35ee5e..93463d88d74 100644
--- a/mysql-test/lib/mtr_report.pm
+++ b/mysql-test/lib/mtr_report.pm
@@ -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);
+  }
 }
 
 
diff --git a/mysql-test/lib/mtr_unique.pm b/mysql-test/lib/mtr_unique.pm
index 294a5d7b4d6..6b60157422d 100644
--- a/mysql-test/lib/mtr_unique.pm
+++ b/mysql-test/lib/mtr_unique.pm
@@ -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";
+  # 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'})
+  {
+    $dir= $ENV{'ALLUSERSPROFILE'}."/mysql-unique-ids";
+  }
+  else
+  {
+    $dir= $ENV{'TEMP'}."/mysql-unique-ids";
+  }
 }
-  
 
-my %mtr_unique_ids;
+my $mtr_unique_fh = undef;
 
-END {
-  my $allocated_id= $mtr_unique_ids{$$};
-  if (defined $allocated_id)
-  {
-    mtr_release_unique_id($allocated_id);
-  }
-  delete $mtr_unique_ids{$$};
+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");
-
-  die "Can only get one unique id per process!" if $mtr_unique_ids{$$};
+  msg("get $min-$max, $$");
 
-  my $ret = undef;
-  my $changed = 0;
-
-  if(eval("readlink '$file'") || eval("readlink '$file.sem'")) {
-    die 'lock file is a symbolic link';
-  }
+  die "Can only get one unique id per process!" if defined $mtr_unique_fh;
 
-  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;
-  }
 
-  msg("HAVE THE LOCK");
+  # 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);
+    }
 
-  if(eval("readlink '$file'") || eval("readlink '$file.sem'")) {
-    die 'lock file is a symbolic link';
-  }
+    mkdir $dir;
+    chmod 0777, $dir;
 
-  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;
     }
-  }
-  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";
+    else
+    {
+      close $fh;
     }
   }
-  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{$$};
 }