diff --git a/mysql-test/lib/My/File/Path.pm b/mysql-test/lib/My/File/Path.pm index b6056bf470f..4ec7fbac33d 100644 --- a/mysql-test/lib/My/File/Path.pm +++ b/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( { - 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 ); }; diff --git a/mysql-test/lib/My/Handles.pm b/mysql-test/lib/My/Handles.pm new file mode 100755 index 00000000000..66ee22b403f --- /dev/null +++ b/mysql-test/lib/My/Handles.pm @@ -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;