From: Yves Orton Date: Sat, 1 Mar 2008 14:40:16 +0000 (+0000) Subject: Synchronize blead with changes from ExtUtils::Install 1.46 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f6d658ccb3241bf660c1870c57e49db3f23e7805;p=p5sagit%2Fp5-mst-13.2.git Synchronize blead with changes from ExtUtils::Install 1.46 Apply patches from Michael Schwern (rt #33688, rt #31429, rt #31248) and from Slaven Rezic (rt #33290). Also implemented the suggestion from Schwern about not dieing when failing to remove a shadow file that is later on in INC than the installed version. (rt #2928) p4raw-id: //depot/perl@33404 --- diff --git a/MANIFEST b/MANIFEST index 44df5db..4e7a1fd 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1811,6 +1811,7 @@ lib/ExtUtils/t/backwards.t Check MakeMaker's backwards compatibility lib/ExtUtils/t/basic.t See if MakeMaker can build a module lib/ExtUtils/t/build_man.t Set if MakeMaker builds manpages lib/ExtUtils/t/bytes.t Test ExtUtils::MakeMaker::bytes +lib/ExtUtils/t/can_write_dir.t Does the _can_write_dir function of ExtUtils::Install work properly? lib/ExtUtils/t/cd.t Test to see cd works lib/ExtUtils/t/config.t Test ExtUtils::MakeMaker::Config lib/ExtUtils/t/Constant.t See if ExtUtils::Constant works diff --git a/lib/ExtUtils/Install.pm b/lib/ExtUtils/Install.pm index 84a616c..5400b7f 100644 --- a/lib/ExtUtils/Install.pm +++ b/lib/ExtUtils/Install.pm @@ -3,7 +3,7 @@ use 5.00503; use strict; use vars qw(@ISA @EXPORT $VERSION $MUST_REBOOT %Config); -$VERSION = '1.45'; +$VERSION = '1.46'; $VERSION = eval $VERSION; use AutoSplit; @@ -395,7 +395,7 @@ Abstract a -w check that tries to use POSIX::access() if possible. sub _have_write_access { my $dir=shift; if (!defined $has_posix) { - $has_posix=eval "local $^W; require POSIX; 1" || 0; + $has_posix=eval 'local $^W; require POSIX; 1' || 0; } if ($has_posix) { return POSIX::access($dir, POSIX::W_OK()); @@ -431,8 +431,11 @@ sub _can_write_dir { return unless defined $dir and length $dir; - my ($vol, $dirs, $file) = File::Spec->splitpath(File::Spec->rel2abs($dir),1); + my ($vol, $dirs, $file) = File::Spec->splitpath($dir,1); my @dirs = File::Spec->splitdir($dirs); + unshift @dirs, File::Spec->curdir + unless File::Spec->file_name_is_absolute($dir); + my $path=''; my @make; while (@dirs) { @@ -769,7 +772,7 @@ reboot. A wrapper for _unlink_or_rename(). sub forceunlink { my ( $file, $tryhard )= @_; #XXX OS-SPECIFIC - _unlink_or_rename( $file, $tryhard ); + _unlink_or_rename( $file, $tryhard, not("installing") ); } =begin _undocumented @@ -886,6 +889,9 @@ Remove shadowed files. If $ignore is true then it is assumed to hold a filename to ignore. This is used to prevent spurious warnings from occuring when doing an install at reboot. +We now only die when failing to remove a file that has precedence over +our own, when our install has precedence we only warn. + =end _undocumented =cut @@ -899,11 +905,17 @@ sub inc_uninstall { my @PERL_ENV_LIB = split $Config{path_sep}, defined $ENV{'PERL5LIB'} ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} || ''; - - foreach $dir (@INC, @PERL_ENV_LIB, @Config{qw(archlibexp - privlibexp - sitearchexp - sitelibexp)}) { + + my @dirs=( @PERL_ENV_LIB, + @INC, + @Config{qw(archlibexp + privlibexp + sitearchexp + sitelibexp)}); + + #warn join "\n","---",@dirs,"---"; + my $seen_ours; + foreach $dir ( @dirs ) { my $canonpath = File::Spec->canonpath($dir); next if $canonpath eq $Curdir; next if $seen_dir{$canonpath}++; @@ -922,7 +934,10 @@ sub inc_uninstall { } print "#$file and $targetfile differ\n" if $diff && $verbose > 1; - next if !$diff or $targetfile eq $ignore; + if (!$diff or $targetfile eq $ignore) { + $seen_ours = 1; + next; + } if ($nonono) { if ($verbose) { $Inc_uninstall_warn_handler ||= ExtUtils::Install::Warn->new(); @@ -935,7 +950,19 @@ sub inc_uninstall { # if not verbose, we just say nothing } else { print "Unlinking $targetfile (shadowing?)\n" if $verbose; - forceunlink($targetfile,'tryhard'); + eval { + die "Fake die for testing" + if $ExtUtils::Install::Testing and + File::Spec->canonpath($ExtUtils::Install::Testing) eq $targetfile; + forceunlink($targetfile,'tryhard'); + 1; + } or do { + if ($seen_ours) { + warn "Failed to remove probably harmless shadow file '$targetfile'\n"; + } else { + die "$@\n"; + } + }; } } } @@ -1131,7 +1158,8 @@ can be used to provide a default. Original author lost in the mists of time. Probably the same as Makemaker. -Production release currently maintained by demerphq C +Production release currently maintained by demerphq C, +extensive changes by Michael Schwern. Send bug reports via http://rt.cpan.org/. Please send your generated Makefile along with your report. diff --git a/lib/ExtUtils/t/Install.t b/lib/ExtUtils/t/Install.t index ae8d781..f9e7666 100644 --- a/lib/ExtUtils/t/Install.t +++ b/lib/ExtUtils/t/Install.t @@ -17,7 +17,7 @@ use TieOut; use File::Path; use File::Spec; -use Test::More tests => 38; +use Test::More tests => 52; use MakeMaker::Test::Setup::BFD; @@ -122,6 +122,56 @@ close DUMMY; ' UNINST=0 left different' ); } +# Test UNINST=1 only warning when failing to remove an irrelevent shadow file +{ + my $tfile='install-test/lib/perl/Big/Dummy.pm'; + local $ExtUtils::Install::Testing = $tfile; + local @INC = ('install-test/other_lib/perl','install-test/lib/perl'); + local $ENV{PERL5LIB} = ''; + ok( -r $tfile, 'different install exists' ); + my @warn; + local $SIG{__WARN__}=sub { push @warn, @_; return }; + my $ok=eval { + install( { 'blib/lib' => 'install-test/other_lib/perl', + read => 'install-test/packlist', + write => 'install-test/packlist' + }, + 0, 0, 1); + 1 + }; + ok($ok,' we didnt die'); + ok(0+@warn," we did warn"); + ok( -d 'install-test/other_lib/perl', 'install made other dir' ); + ok( -r 'install-test/other_lib/perl/Big/Dummy.pm', ' .pm file installed' ); + ok( -r 'install-test/packlist', ' packlist exists' ); + ok( -r $tfile, ' UNINST=1 failed to remove different' ); + +} + +# Test UNINST=1 dieing when failing to remove an relevent shadow file +{ + my $tfile='install-test/lib/perl/Big/Dummy.pm'; + local $ExtUtils::Install::Testing = $tfile; + local @INC = ('install-test/lib/perl','install-test/other_lib/perl'); + local $ENV{PERL5LIB} = ''; + ok( -r $tfile, 'different install exists' ); + my @warn; + local $SIG{__WARN__}=sub { push @warn,@_; return }; + my $ok=eval { + install( { 'blib/lib' => 'install-test/other_lib/perl', + read => 'install-test/packlist', + write => 'install-test/packlist' + }, + 0, 0, 1); + 1 + }; + ok(!$ok,' we did die'); + ok(!@warn," we didnt warn"); + ok( -d 'install-test/other_lib/perl', 'install made other dir' ); + ok( -r 'install-test/other_lib/perl/Big/Dummy.pm', ' .pm file installed' ); + ok( -r 'install-test/packlist', ' packlist exists' ); + ok( -r $tfile,' UNINST=1 failed to remove different' ); +} # Test UNINST=1 removing other versions in other dirs. { @@ -138,3 +188,4 @@ close DUMMY; ok( !-r 'install-test/lib/perl/Big/Dummy.pm', ' UNINST=1 removed different' ); } + diff --git a/lib/ExtUtils/t/can_write_dir.t b/lib/ExtUtils/t/can_write_dir.t new file mode 100755 index 0000000..4d4df0b --- /dev/null +++ b/lib/ExtUtils/t/can_write_dir.t @@ -0,0 +1,55 @@ +#!/usr/bin/perl -w + +# Test the private _can_write_dir() function. + +use strict; +use ExtUtils::Install; +use File::Spec; +{ package FS; our @ISA = qw(File::Spec); } + +# Alias it for easier access +*can_write_dir = \&ExtUtils::Install::_can_write_dir; + +use Test::More 'no_plan'; + + +my $dne = FS->catdir(qw(does not exist)); +ok ! -e $dne; +is_deeply [can_write_dir($dne)], + [1, + FS->curdir, + FS->catdir('does'), + FS->catdir('does', 'not'), + FS->catdir('does', 'not', 'exist') + ]; + + +my $abs_dne = FS->rel2abs($dne); +ok ! -e $abs_dne; +is_deeply [can_write_dir($abs_dne)], + [1, + FS->rel2abs(FS->curdir), + FS->rel2abs(FS->catdir('does')), + FS->rel2abs(FS->catdir('does', 'not')), + FS->rel2abs(FS->catdir('does', 'not', 'exist')), + ]; + + +my $exists = FS->catdir(qw(exists)); +my $subdir = FS->catdir(qw(exists subdir)); +ok mkdir $exists; +END { rmdir $exists } + +ok chmod 0555, $exists, 'make read only'; +ok !-w $exists; +is_deeply [can_write_dir($exists)], [0, $exists]; +is_deeply [can_write_dir($subdir)], [0, $exists, $subdir]; + +ok chmod 0777, $exists, 'make writable'; +ok -w $exists; +is_deeply [can_write_dir($exists)], [1, $exists]; +is_deeply [can_write_dir($subdir)], + [1, + $exists, + $subdir + ];