For now, remove the 'cannot remove [dir] when cwd is [dir]' message,

because the existing code will think that /tmp/abc is a subdirectory
of /tmp/aa, and whilst we have a patch for Win32 and *nix, we've not
tested on VMS, which has "interesting" path syntax.

p4raw-id: //depot/perl@35009

diff --git a/lib/File/Path.pm b/lib/File/Path.pm
index 602a500..932ae64 100644 (file)
--- a/lib/File/Path.pm
+++ b/lib/File/Path.pm
@@ -166,19 +166,6 @@ sub rmtree {
     for ($arg->{cwd}) { /\A(.*)\Z/; $_ = $1 } # untaint
 
     for my $p (@$paths) {
-        # need to fixup case and map \ to / on Windows
-        my $ortho_root = $^O eq 'MSWin32' ? _slash_lc($p)          : $p;
-        my $ortho_cwd  = $^O eq 'MSWin32' ? _slash_lc($arg->{cwd}) : $arg->{cwd};
-        my $ortho_root_length = length($ortho_root);
-        $ortho_root_length-- if $^O eq 'VMS'; # don't compare '.' with ']'
-        if ($ortho_root_length
-            && (substr($ortho_root, 0, $ortho_root_length) 
-             eq substr($ortho_cwd, 0, $ortho_root_length))) {
-            local $! = 0;
-            _error($arg, "cannot remove path when cwd is $arg->{cwd}", $p);
-            next;
-        }
-
         if ($Is_MacOS) {
             $p  = ":$p" unless $p =~ /:/;
             $p .= ":"   unless $p =~ /:\z/;
@@ -746,15 +733,6 @@ C<remove_tree>, after having deleted everything in a directory, attempted
 to restore its permissions to the original state but failed. The
 directory may wind up being left behind.
 
-=item cannot remove [dir] when cwd is [dir]
-
-The current working directory of the program is F</some/path/to/here>
-and you are attempting to remove an ancestor, such as F</some/path>.
-The directory tree is left untouched.
-
-The solution is to C<chdir> out of the child directory to a place
-outside the directory tree to be removed.
-
 =item cannot chdir to [parent-dir] from [child-dir]: [errmsg], aborting. (FATAL)
 
 C<remove_tree>, after having deleted everything and restored the permissions

diff --git a/lib/File/Path.t b/lib/File/Path.t
index 34e316e..ca9eaf6 100755 (executable)
--- a/lib/File/Path.t
+++ b/lib/File/Path.t
@@ -2,7 +2,7 @@
 
 use strict;
 
-use Test::More tests => 114;
+use Test::More tests => 108;
 use Config;
 
 BEGIN {
@@ -138,43 +138,6 @@ sub count {
     rmtree 'solo';
 }
 
-SKIP: {
-    # tests for rmtree() of ancestor directory
-    my $nr_tests = 6;
-    my $cwd = getcwd() or skip "failed to getcwd: $!", $nr_tests;
-    my $dir  = catdir($cwd, 'remove');
-    my $dir2 = catdir($cwd, 'remove', 'this', 'dir');
-
-    skip "failed to mkpath '$dir2': $!", $nr_tests
-        unless mkpath($dir2, {verbose => 0});
-    skip "failed to chdir dir '$dir2': $!", $nr_tests
-        unless chdir($dir2);
-
-    rmtree($dir, {error => \$error});
-    my $nr_err = @$error;
-    is($nr_err, 1, "ancestor error");
-
-    if ($nr_err) {
-        my ($file, $message) = each %{$error->[0]};
-        is($file, $dir, "ancestor named");
-        my $ortho_dir = $^O eq 'MSWin32' ? File::Path::_slash_lc($dir2) : $dir2;
-        $^O eq 'MSWin32' and $message
-            =~ s/\A(cannot remove path when cwd is )(.*)\Z/$1 . File::Path::_slash_lc($2)/e;
-        is($message, "cannot remove path when cwd is $ortho_dir", "ancestor reason");
-        ok(-d $dir2, "child not removed");
-        ok(-d $dir, "ancestor not removed");
-    }
-    else {
-        fail( "ancestor 1");
-        fail( "ancestor 2");
-        fail( "ancestor 3");
-        fail( "ancestor 4");
-    }
-    chdir $cwd;
-    rmtree($dir);
-    ok(!(-d $dir), "ancestor now removed");
-};
-
 my $count = rmtree({error => \$error});
 is( $count, 0, 'rmtree of nothing, count of zero' );
 is( scalar(@$error), 0, 'no diagnostic captured' );