Upgrade to Math-Complex-1.47

[p5sagit/p5-mst-13.2.git] / lib / File / Path.t

diff --git a/lib/File/Path.t b/lib/File/Path.t
index 1a5f326..f1b5928 100755 (executable)
--- a/lib/File/Path.t
+++ b/lib/File/Path.t
@@ -2,7 +2,7 @@
 
 use strict;
 
-use Test::More tests => 93;
+use Test::More tests => 99;
 
 BEGIN {
     use_ok('File::Path');
@@ -12,6 +12,8 @@ BEGIN {
 eval "use Test::Output";
 my $has_Test_Output = $@ ? 0 : 1;
 
+my $Is_VMS   = $^O eq 'VMS';
+
 # first check for stupid permissions second for full, so we clean up
 # behind ourselves
 for my $perm (0111,0777) {
@@ -52,6 +54,25 @@ is(scalar(@created), 7, "created list of directories");
 is(scalar(@created), 0, "skipped making existing directory")
     or diag("unexpectedly recreated @created");
 
+# create a file
+my $file_name = catfile( $tmp_base, 'a', 'delete.me' );
+my $file_count = 0;
+if (open OUT, "> $file_name") {
+    print OUT "this file may be deleted\n";
+    close OUT;
+    ++$file_count;
+}
+else {
+    diag( "Failed to create file $file_name: $!" );
+}
+
+SKIP: {
+    skip "cannot remove a file we failed to create", 1
+        unless $file_count == 1;
+    my $count = rmtree($file_name);
+    is($count, 1, "rmtree'ed a file");
+}
+
 @created = mkpath('');
 is(scalar(@created), 0, "Can't create a directory named ''");
 
@@ -82,7 +103,7 @@ is(scalar(@created), 0, "skipped making existing directories (old style 1)")
 
 $dir = catdir($tmp_base,'C');
 # mkpath returns unix syntax filespecs on VMS
-$dir = VMS::Filespec::unixify($dir) if $^O eq 'VMS';
+$dir = VMS::Filespec::unixify($dir) if $Is_VMS;
 @created = mkpath($tmp_base, $dir);
 is(scalar(@created), 1, "created directory (new style 1)");
 is($created[0], $dir, "created directory (new style 1) cross-check");
@@ -93,16 +114,17 @@ is(scalar(@created), 0, "skipped making existing directories (old style 2)")
 
 $dir2 = catdir($tmp_base,'D');
 # mkpath returns unix syntax filespecs on VMS
-$dir2 = VMS::Filespec::unixify($dir2) if $^O eq 'VMS';
+$dir2 = VMS::Filespec::unixify($dir2) if $Is_VMS;
 @created = mkpath($tmp_base, $dir, $dir2);
 is(scalar(@created), 1, "created directory (new style 2)");
 is($created[0], $dir2, "created directory (new style 2) cross-check");
 
 $count = rmtree($dir, 0);
-is($count, 1, "removed directory (old style 1)");
+is($count, 1, "removed directory unsafe mode");
 
 $count = rmtree($dir2, 0, 1);
-is($count, 1, "removed directory (old style 2)");
+my $removed = $Is_VMS ? 0 : 1;
+is($count, $removed, "removed directory safe mode");
 
 # mkdir foo ./E/../Y
 # Y should exist
@@ -137,7 +159,7 @@ ok(-d $dir2, "dir z still exists");
 
 $dir = catdir($tmp_base,'F');
 # mkpath returns unix syntax filespecs on VMS
-$dir = VMS::Filespec::unixify($dir) if $^O eq 'VMS';
+$dir = VMS::Filespec::unixify($dir) if $Is_VMS;
 
 @created = mkpath($dir, undef, 0770);
 is(scalar(@created), 1, "created directory (old style 2 verbose undef)");
@@ -155,7 +177,7 @@ is($created[0], $dir, "created directory (old style 3 mode undef) cross-check");
 is(rmtree($dir, 0, undef), 1, "removed directory 3 verbose undef");
 
 $dir = catdir($tmp_base,'G');
-$dir = VMS::Filespec::unixify($dir) if $^O eq 'VMS';
+$dir = VMS::Filespec::unixify($dir) if $Is_VMS;
 
 @created = mkpath($dir, undef, 0200);
 is(scalar(@created), 1, "created write-only dir");
@@ -221,7 +243,7 @@ SKIP: {
 my $extra =  catdir(curdir(), qw(EXTRA 1 a));
 
 SKIP: {
-    skip "extra scenarios not set up, see eg/setup-extra-tests", 9
+    skip "extra scenarios not set up, see eg/setup-extra-tests", 14
         unless -e $extra;
 
     my ($list, $err);
@@ -238,17 +260,30 @@ SKIP: {
     $dir = catdir('EXTRA', '3', 'S');
     rmtree($dir, {error => \$error});
     is( scalar(@$error), 1, 'one error for an unreadable dir' );
+    eval { ($file, $message) = each %{$error->[0]}};
+    is( $file, $dir, 'unreadable dir reported in error' )
+        or diag($message);
 
     $dir = catdir('EXTRA', '3', 'T');
     rmtree($dir, {error => \$error});
-    is( scalar(@$error), 1, 'one error for an unreadable dir' );
+    is( scalar(@$error), 1, 'one error for an unreadable dir T' );
+    eval { ($file, $message) = each %{$error->[0]}};
+    is( $file, $dir, 'unreadable dir reported in error T' );
 
     $dir = catdir( 'EXTRA', '4' );
     rmtree($dir,  {result => \$list, error => \$err} );
-    is( @$list, 0, q{don't follow a symlinked dir} );
-    is( @$err,  2, q{two errors when removing a symlink in r/o dir} );
+    is( scalar(@$list), 0, q{don't follow a symlinked dir} );
+    is( scalar(@$err),  2, q{two errors when removing a symlink in r/o dir} );
     eval { ($file, $message) = each %{$err->[0]} };
     is( $file, $dir, 'symlink reported in error' );
+
+    $dir  = catdir('EXTRA', '3', 'U');
+    $dir2 = catdir('EXTRA', '3', 'V');
+    rmtree($dir, $dir2, {verbose => 0, error => \$err, result => \$list});
+    is( scalar(@$list),  1, q{deleted 1 out of 2 directories} );
+    is( scalar(@$error), 1, q{left behind 1 out of 2 directories} );
+    eval { ($file, $message) = each %{$err->[0]} };
+    is( $file, $dir, 'first dir reported in error' );
 }
 
 {