Author: dagolden
Date: Thu Sep 3 04:43:06 2009
New Revision: 13264
Modified:
Module-Build/trunk/t/lib/DistGen.pm
Module-Build/trunk/t/lib/MBTest.pm
Log:
Fixed subtle MBTest->tmpdir bug for use with DistGen
Under $ENV{PERL_CORE}, each call to MBTest->tmpdir was using *current*
cwd() as a base directory for temporary directories with File::Temp.
This is wrong because DistGen can potentially call tmpdir multiple
times in a test file, sometimes from within other temporary
directories, causing nesting of temporary directories (with obvious
complications for deletion).
I fixed MBTest->tmpdir to use the *original* cwd from when MBTest was
loaded. With that, we can go back to relying on File::Temp to do
proper tmpdir cleanup, and the recent hackish cleanup code has been
removed from DistGen.
DistGen has an END block to do a multi-volume-safe chdir back to the
original cwd, which means tests no longer need to worry about changing
back to the original directory themselves or calling $dist->remove to
change directories and cleanup there. Thus, test code has fewer
"cleanup" type calls, and cleanup just happens as needed at the end.
Modified: Module-Build/trunk/t/lib/DistGen.pm
==============================================================================
--- Module-Build/trunk/t/lib/DistGen.pm (original)
+++ Module-Build/trunk/t/lib/DistGen.pm Thu Sep 3 04:43:06 2009
@@ -72,52 +72,43 @@
########################################################################
-{
- my @CLEANUP_DIRS;
+END { chdir_all(MBTest->original_cwd); }
- END {
- chdir_all(MBTest->original_cwd);
- File::Path::rmtree($_) for @CLEANUP_DIRS;
- }
-
- sub new {
- my $self = bless {}, shift;
- $self->reset(@_);
- }
-
- sub reset {
- my $self = shift;
- my %options = @_;
+sub new {
+ my $self = bless {}, shift;
+ $self->reset(@_);
+}
- $options{name} ||= 'Simple';
- $options{dir} ||= MBTest->tmpdir( CLEANUP => 0 );
+sub reset {
+ my $self = shift;
+ my %options = @_;
- my %data = (
- no_manifest => 0,
- xs => 0,
- %options,
- );
- %$self = %data;
+ $options{name} ||= 'Simple';
+ $options{dir} = File::Spec->rel2abs(
+ defined $options{dir} ? $options{dir} : MBTest->tmpdir
+ );
- # So we can clean up later even if the caller chdir()s
- $self->{dir} = File::Spec->rel2abs($self->{dir});
- push @CLEANUP_DIRS, $self->{dir};
+ my %data = (
+ no_manifest => 0,
+ xs => 0,
+ %options,
+ );
+ %$self = %data;
- tie %{$self->{filedata}}, 'Tie::CPHash';
+ tie %{$self->{filedata}}, 'Tie::CPHash';
- tie %{$self->{pending}{change}}, 'Tie::CPHash';
+ tie %{$self->{pending}{change}}, 'Tie::CPHash';
- # start with a fresh, empty directory
- if ( -d $self->dirname ) {
- warn "Warning: Removing existing directory '@{[$self->dirname]}'\n";
- File::Path::rmtree( $self->dirname );
- }
- File::Path::mkpath( $self->dirname );
+ # start with a fresh, empty directory
+ if ( -d $self->dirname ) {
+ warn "Warning: Removing existing directory '@{[$self->dirname]}'\n";
+ File::Path::rmtree( $self->dirname );
+ }
+ File::Path::mkpath( $self->dirname );
- $self->_gen_default_filedata();
+ $self->_gen_default_filedata();
- return $self;
- }
+ return $self;
}
sub remove {
Modified: Module-Build/trunk/t/lib/MBTest.pm
==============================================================================
--- Module-Build/trunk/t/lib/MBTest.pm (original)
+++ Module-Build/trunk/t/lib/MBTest.pm Thu Sep 3 04:43:06 2009
@@ -103,7 +103,7 @@
# always return to the current directory
{
- my $cwd = Cwd::cwd;
+ my $cwd = File::Spec->rel2abs(Cwd::cwd);
sub original_cwd { return $cwd }
@@ -123,10 +123,10 @@
}
########################################################################
-# Setup a temp directory
-sub tmpdir {
+# Setup a temp directory
+sub tmpdir {
my ($self, @args) = @_;
- my $dir = $ENV{PERL_CORE} ? Cwd::cwd : File::Spec->tmpdir;
+ my $dir = $ENV{PERL_CORE} ? MBTest->original_cwd : File::Spec->tmpdir;
return File::Temp::tempdir('MB-XXXXXXXX', CLEANUP => 1, DIR => $dir, @args);
}
