From: Nicholas Clark Date: Tue, 25 Mar 2008 16:55:03 +0000 (+0000) Subject: Patches for VMS by Craig Berry from X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=553b5000d7907cb0cb8f4658c1d6a2aac379415b;p=p5sagit%2Fp5-mst-13.2.git Patches for VMS by Craig Berry from http://rt.cpan.org/Public/Bug/Display.html?id=34095 (1.50 has 3 failures on VMS) p4raw-id: //depot/perl@33567 --- diff --git a/lib/ExtUtils/Install.pm b/lib/ExtUtils/Install.pm index 4d033aa..aec9aca 100644 --- a/lib/ExtUtils/Install.pm +++ b/lib/ExtUtils/Install.pm @@ -38,7 +38,7 @@ ExtUtils::Install - install files from here to there =head1 VERSION -1.50_01 +1.51 =cut @@ -248,8 +248,9 @@ sub _unlink_or_rename { #XXX OS-SPECIFIC my ( $file, $tryhard, $installing )= @_; _chmod( 0666, $file ); - unlink $file - and return $file; + my $unlink_count = 0; + while (unlink $file) { $unlink_count++; } + return $file if $unlink_count > 0; my $error="$!"; _choke("Cannot unlink '$file': $!") @@ -404,9 +405,14 @@ sub _can_write_dir { my $path=''; my @make; while (@dirs) { - $dir = File::Spec->catdir(@dirs); - $dir = File::Spec->catpath($vol,$dir,'') - if defined $vol and length $vol; + if ($Is_VMS) { + $dir = File::Spec->catdir($vol,@dirs); + } + else { + $dir = File::Spec->catdir(@dirs); + $dir = File::Spec->catpath($vol,$dir,'') + if defined $vol and length $vol; + } next if ( $dir eq $path ); if ( ! -e $dir ) { unshift @make,$dir; @@ -1040,7 +1046,7 @@ sub inc_uninstall { #warn join "\n","---",@dirs,"---"; my $seen_ours; foreach $dir ( @dirs ) { - my $canonpath = File::Spec->canonpath($dir); + my $canonpath = $Is_VMS ? $dir : File::Spec->canonpath($dir); next if $canonpath eq $Curdir; next if $seen_dir{$canonpath}++; my $targetfile = File::Spec->catfile($canonpath,$libdir,$file); @@ -1078,7 +1084,7 @@ sub inc_uninstall { eval { die "Fake die for testing" if $ExtUtils::Install::Testing and - File::Spec->canonpath($ExtUtils::Install::Testing) eq $targetfile; + ucase(File::Spec->canonpath($ExtUtils::Install::Testing)) eq ucase($targetfile); forceunlink($targetfile,'tryhard'); $results->{uninstall}{$targetfile} = $filepath; 1; @@ -1225,7 +1231,8 @@ sub DESTROY { } $plural = $i>1 ? "all those files" : "this file"; my $inst = (_invokant() eq 'ExtUtils::MakeMaker') - ? ( $Config::Config{make} || 'make' ).' install UNINST=1' + ? ( $Config::Config{make} || 'make' ).' install' + . ( $Is_VMS ? '/MACRO="UNINST"=1' : ' UNINST=1' ) : './Build install uninst=1'; print "## Running '$inst' will unlink $plural for you.\n"; } diff --git a/lib/ExtUtils/t/Installapi2.t b/lib/ExtUtils/t/Installapi2.t index 0b9ba0d..c59b8ab 100644 --- a/lib/ExtUtils/t/Installapi2.t +++ b/lib/ExtUtils/t/Installapi2.t @@ -208,7 +208,10 @@ close DUMMY; 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( (stat $tfile)[9]==(stat$sfile)[9],' Times are same'); +SKIP: { + skip "Times not preserved during copy by default", 1 if $^O eq 'VMS'; + ok( (stat $tfile)[9]==(stat $sfile)[9],' Times are same'); +} ok( !$result{install_unchanged},' $result{install_unchanged} should be empty'); } # Test nothing is copied. @@ -232,4 +235,4 @@ close DUMMY; ok( (stat $tfile)[9]!=(stat$sfile)[9],' Times are different'); ok( !$result{install},' nothing should have been installed'); ok( $result{install_unchanged},' install_unchanged should be populated'); -} \ No newline at end of file +}