use strict;
-use Test::More tests => 93;
+use Test::More tests => 99;
BEGIN {
use_ok('File::Path');
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) {
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 ''");
$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");
$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
$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)");
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");
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);
$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' );
}
{