Author: ericwilhelm
Date: Wed Jul 9 01:22:18 2008
New Revision: 11502
Modified:
Module-Build/trunk/t/basic.t
Module-Build/trunk/t/compat.t
Module-Build/trunk/t/destinations.t
Module-Build/trunk/t/extend.t
Module-Build/trunk/t/files.t
Module-Build/trunk/t/install.t
Module-Build/trunk/t/lib/DistGen.pm
Module-Build/trunk/t/lib/MBTest.pm
Module-Build/trunk/t/manifypods.t
Module-Build/trunk/t/metadata.t
Module-Build/trunk/t/metadata2.t
Module-Build/trunk/t/moduleinfo.t
Module-Build/trunk/t/new_from_context.t
Module-Build/trunk/t/notes.t
Module-Build/trunk/t/par.t
Module-Build/trunk/t/ppm.t
Module-Build/trunk/t/runthrough.t
Module-Build/trunk/t/signature.t
Module-Build/trunk/t/test_type.t
Module-Build/trunk/t/test_types.t
Module-Build/trunk/t/tilde.t
Module-Build/trunk/t/xs.t
Log:
** David Wheeler noticed that 5.10 on osx gets mad about deleting the
** current directory. It turns out that most tests were doing this.
t/lib/DistGen.pm - added did_chdir(),
automatically chdir_original() in remove(),
check for bad cwd after removal
t/lib/MBTest.pm - return to original $cwd before deleting $tmp
t/*.t - made all of the tests use chdir_in()
Modified: Module-Build/trunk/t/basic.t
==============================================================================
--- Module-Build/trunk/t/basic.t (original)
+++ Module-Build/trunk/t/basic.t Wed Jul 9 01:22:18 2008
@@ -13,7 +13,7 @@
my $dist = DistGen->new( dir => $tmp );
$dist->regen;
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
#########################
@@ -166,7 +166,7 @@
$dist->remove;
$dist = DistGen->new( dir => $tmp );
$dist->regen;
- chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+ $dist->chdir_in;
}
# Test author stuff
Modified: Module-Build/trunk/t/compat.t
==============================================================================
--- Module-Build/trunk/t/compat.t (original)
+++ Module-Build/trunk/t/compat.t Wed Jul 9 01:22:18 2008
@@ -38,7 +38,7 @@
my $dist = DistGen->new( dir => $tmp );
$dist->regen;
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
#########################
Modified: Module-Build/trunk/t/destinations.t
==============================================================================
--- Module-Build/trunk/t/destinations.t (original)
+++ Module-Build/trunk/t/destinations.t Wed Jul 9 01:22:18 2008
@@ -13,7 +13,7 @@
my $dist = DistGen->new( dir => $tmp );
$dist->regen;
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
use Config;
Modified: Module-Build/trunk/t/extend.t
==============================================================================
--- Module-Build/trunk/t/extend.t (original)
+++ Module-Build/trunk/t/extend.t Wed Jul 9 01:22:18 2008
@@ -13,7 +13,7 @@
my $dist = DistGen->new( dir => $tmp );
$dist->regen;
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
#########################
Modified: Module-Build/trunk/t/files.t
==============================================================================
--- Module-Build/trunk/t/files.t (original)
+++ Module-Build/trunk/t/files.t Wed Jul 9 01:22:18 2008
@@ -14,7 +14,7 @@
my $dist = DistGen->new( dir => $tmp );
$dist->regen;
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
Modified: Module-Build/trunk/t/install.t
==============================================================================
--- Module-Build/trunk/t/install.t (original)
+++ Module-Build/trunk/t/install.t Wed Jul 9 01:22:18 2008
@@ -15,8 +15,7 @@
use DistGen;
my $dist = DistGen->new( dir => $tmp );
$dist->regen;
-
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
#########################
@@ -229,7 +228,7 @@
$dist->remove;
$dist = DistGen->new( dir => $tmp );
$dist->regen;
- chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+ $dist->chdir_in;
}
sub strip_volume {
Modified: Module-Build/trunk/t/lib/DistGen.pm
==============================================================================
--- Module-Build/trunk/t/lib/DistGen.pm (original)
+++ Module-Build/trunk/t/lib/DistGen.pm Wed Jul 9 01:22:18 2008
@@ -364,7 +364,10 @@
sub remove {
my $self = shift;
croak("invalid usage -- remove()") if(@_);
+ $self->chdir_original if($self->did_chdir);
File::Path::rmtree( $self->dirname );
+ # might as well check
+ croak("\nthis test should have used chdir_in()") unless(Cwd::getcwd);
}
sub revert {
@@ -417,7 +420,14 @@
$self->{original_dir} ||= Cwd::cwd; # only once
my $dir = $self->dirname;
chdir($dir) or die "Can't chdir to '$dir': $!";
-} # end subroutine chdir_in definition
+}
+########################################################################
+
+sub did_chdir {
+ my $self = shift;
+
+ return exists($self->{original_dir});
+}
########################################################################
sub chdir_original {
@@ -426,7 +436,7 @@
croak("never called chdir_in()") unless($self->{original_dir});
my $dir = $self->{original_dir};
chdir($dir) or die "Can't chdir to '$dir': $!";
-} # end subroutine chdir_original definition
+}
########################################################################
1;
Modified: Module-Build/trunk/t/lib/MBTest.pm
==============================================================================
--- Module-Build/trunk/t/lib/MBTest.pm (original)
+++ Module-Build/trunk/t/lib/MBTest.pm Wed Jul 9 01:22:18 2008
@@ -69,7 +69,9 @@
sub tmpdir { $tmp }
END {
if(-d $tmp) {
- File::Path::rmtree($tmp) or warn "cannot clean dir '$tmp'";
+ # Go back to where you came from!
+ chdir $cwd or die "Couldn't chdir to $cwd";
+ File::Path::rmtree($tmp) or diag "cannot clean dir '$tmp'";
}
}
}
Modified: Module-Build/trunk/t/manifypods.t
==============================================================================
--- Module-Build/trunk/t/manifypods.t (original)
+++ Module-Build/trunk/t/manifypods.t Wed Jul 9 01:22:18 2008
@@ -57,7 +57,7 @@
$dist->regen;
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
use File::Spec::Functions qw( catdir );
my $destdir = catdir($cwd, 't', 'install_test' . $$);
@@ -142,7 +142,7 @@
$dist->remove;
$dist = DistGen->new( dir => $tmp );
$dist->regen;
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
my $mb2 = Module::Build->new(
Modified: Module-Build/trunk/t/metadata.t
==============================================================================
--- Module-Build/trunk/t/metadata.t (original)
+++ Module-Build/trunk/t/metadata.t Wed Jul 9 01:22:18 2008
@@ -44,7 +44,7 @@
}
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
use Module::Build;
my $mb = Module::Build->new_from_context;
Modified: Module-Build/trunk/t/metadata2.t
==============================================================================
--- Module-Build/trunk/t/metadata2.t (original)
+++ Module-Build/trunk/t/metadata2.t Wed Jul 9 01:22:18 2008
@@ -22,7 +22,7 @@
my $dist = DistGen->new( dir => $tmp, skip_manifest => 1 );
$dist->regen;
- chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+ $dist->chdir_in;
ok ! -e 'MANIFEST';
@@ -73,7 +73,7 @@
});
$dist->regen;
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
# .pm File with pod
Modified: Module-Build/trunk/t/moduleinfo.t
==============================================================================
--- Module-Build/trunk/t/moduleinfo.t (original)
+++ Module-Build/trunk/t/moduleinfo.t Wed Jul 9 01:22:18 2008
@@ -15,7 +15,7 @@
my $dist = DistGen->new( dir => $tmp );
$dist->regen;
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
#########################
@@ -202,7 +202,7 @@
$dist->remove;
$dist = DistGen->new( dir => $tmp );
$dist->regen;
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
# Find each package only once
@@ -260,7 +260,7 @@
$dist->remove;
$dist = DistGen->new( dir => $tmp );
$dist->regen;
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
# parse $VERSION lines scripts for package main
Modified: Module-Build/trunk/t/new_from_context.t
==============================================================================
--- Module-Build/trunk/t/new_from_context.t (original)
+++ Module-Build/trunk/t/new_from_context.t Wed Jul 9 01:22:18 2008
@@ -17,7 +17,7 @@
$dist->add_file("$libdir/Build.PL", 'die');
$dist->regen;
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
unshift(@INC, $libdir);
Modified: Module-Build/trunk/t/notes.t
==============================================================================
--- Module-Build/trunk/t/notes.t (original)
+++ Module-Build/trunk/t/notes.t Wed Jul 9 01:22:18 2008
@@ -13,7 +13,7 @@
my $dist = DistGen->new( dir => $tmp );
$dist->regen;
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
###################################
Modified: Module-Build/trunk/t/par.t
==============================================================================
--- Module-Build/trunk/t/par.t (original)
+++ Module-Build/trunk/t/par.t Wed Jul 9 01:22:18 2008
@@ -54,7 +54,7 @@
});
$dist->regen;
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
use File::Spec::Functions qw(catdir);
Modified: Module-Build/trunk/t/ppm.t
==============================================================================
--- Module-Build/trunk/t/ppm.t (original)
+++ Module-Build/trunk/t/ppm.t Wed Jul 9 01:22:18 2008
@@ -57,7 +57,7 @@
});
$dist->regen;
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
use File::Spec::Functions qw(catdir);
Modified: Module-Build/trunk/t/runthrough.t
==============================================================================
--- Module-Build/trunk/t/runthrough.t (original)
+++ Module-Build/trunk/t/runthrough.t Wed Jul 9 01:22:18 2008
@@ -55,7 +55,7 @@
---
$dist->regen;
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
#########################
@@ -217,7 +217,7 @@
$dist->add_file( 'bin/script.bat', $script_data );
$dist->regen;
- chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+ $dist->chdir_in;
$mb = Module::Build->new_from_context;
ok $mb;
Modified: Module-Build/trunk/t/signature.t
==============================================================================
--- Module-Build/trunk/t/signature.t (original)
+++ Module-Build/trunk/t/signature.t Wed Jul 9 01:22:18 2008
@@ -31,7 +31,7 @@
});
$dist->regen;
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
#########################
@@ -46,7 +46,7 @@
# Make sure the signature actually verifies
ok Module::Signature::verify() == Module::Signature::SIGNATURE_OK();
- chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+ $dist->chdir_in;
}
{
@@ -80,7 +80,7 @@
eval { $mb->dispatch('realclean') };
is $@, '';
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
{
local @ARGV = '--sign=1';
Modified: Module-Build/trunk/t/test_type.t
==============================================================================
--- Module-Build/trunk/t/test_type.t (original)
+++ Module-Build/trunk/t/test_type.t Wed Jul 9 01:22:18 2008
@@ -23,7 +23,7 @@
$dist->regen;
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
#########################
Modified: Module-Build/trunk/t/test_types.t
==============================================================================
--- Module-Build/trunk/t/test_types.t (original)
+++ Module-Build/trunk/t/test_types.t Wed Jul 9 01:22:18 2008
@@ -34,9 +34,7 @@
---
$dist->regen;
-
-chdir($dist->dirname) or die "Can't chdir to '@{[$dist->dirname]}': $!";
-
+$dist->chdir_in;
#########################
my $mb = Module::Build->subclass(
@@ -116,8 +114,7 @@
ok 1;
---
$dist->regen;
-
-chdir($dist->dirname) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
my $mb = Module::Build->subclass(
code => q#
Modified: Module-Build/trunk/t/tilde.t
==============================================================================
--- Module-Build/trunk/t/tilde.t (original)
+++ Module-Build/trunk/t/tilde.t Wed Jul 9 01:22:18 2008
@@ -15,7 +15,7 @@
my $dist = DistGen->new( dir => $tmp );
$dist->regen;
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
sub run_sample {
Modified: Module-Build/trunk/t/xs.t
==============================================================================
--- Module-Build/trunk/t/xs.t (original)
+++ Module-Build/trunk/t/xs.t Wed Jul 9 01:22:18 2008
@@ -29,7 +29,7 @@
my $dist = DistGen->new( dir => $tmp, xs => 1 );
$dist->regen;
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
my $mb = Module::Build->new_from_context;
@@ -112,7 +112,7 @@
$dist = DistGen->new( name => 'Simple::With::Deep::Name',
dir => $tmp, xs => 1 );
$dist->regen;
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
$mb = Module::Build->new_from_context;
is $@, '';
@@ -205,7 +205,7 @@
---
$dist->regen;
-chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+$dist->chdir_in;
$mb = Module::Build->new_from_context;
