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 (file)
--- 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 (file)
--- 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<yves at cpan.org>
+Production release currently maintained by demerphq C<yves at cpan.org>,
+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 (file)
--- 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 (executable)
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
+          ];