From f6d658ccb3241bf660c1870c57e49db3f23e7805 Mon Sep 17 00:00:00 2001 From: Yves Orton Date: Sat, 1 Mar 2008 14:40:16 +0000 Subject: 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 --- lib/ExtUtils/t/Install.t | 53 +++++++++++++++++++++++++++++++++++++++- lib/ExtUtils/t/can_write_dir.t | 55 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 107 insertions(+), 1 deletion(-) create mode 100755 lib/ExtUtils/t/can_write_dir.t (limited to 'lib/ExtUtils/t') diff --git a/lib/ExtUtils/t/Install.t b/lib/ExtUtils/t/Install.t index ae8d781104..f9e76668d9 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 0000000000..4d4df0bb88 --- /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 + ]; -- cgit v1.2.1