Commit 2359d44c authored by Magnus Svensson's avatar Magnus Svensson
Browse files

Merge

parents b6d6062d 846c8e03

Makefile.am

+4 −0
Original line number Diff line number Diff line
@@ -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

+5 −3
Original line number Diff line number Diff line
@@ -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

+24 −17
Original line number Diff line number Diff line
@@ -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): $!");



  # Call rmtree from File::Path

  goto &File::Path::rmtree;

	     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 );

};

mysql-test/lib/My/Handles.pm

0 → 100755
+69 −0
Original line number Diff line number Diff line 
# -*- 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

+1 −1
Original line number Diff line number Diff line
@@ -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