Merge

Makefile.am

@@ -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:

mysql-test/lib/My/CoreDump.pm

@@ -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";

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

@@ -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( {
+	 bydepth 		=> 1,
 	 no_chdir 		=> 1,
 	 wanted => sub {
-	   chmod(0777, $_)
-	     or warn("couldn't chmod(0777, $_): $!");
-	 }
-	},
-	$dir
-      );
+	   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);
 
-  # Call rmtree from File::Path
-  goto &File::Path::rmtree;
+	     # 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 );
 };
 
 

mysql-test/lib/My/Handles.pm

+# -*- 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;

mysql-test/lib/My/Platform.pm

@@ -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

mysql-test/lib/My/SafeProcess.pm

@@ -66,9 +66,11 @@ END {
   for my $proc (values %running){
     if ( $proc->is_child($$) ){
       #print "Killing: $proc\n";
+      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

mysql-test/lib/My/SafeProcess/Base.pm

@@ -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';

mysql-test/lib/My/SafeProcess/safe_kill_win.cc

@@ -49,6 +49,19 @@ 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

mysql-test/mysql-test-run.pl

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