1#!/usr/bin/perl
2
3# Test that File::Remove can recursively remove a directory that
4# deeply contains a readonly file that is owned by the current user.
5use strict;
6BEGIN {
7    $|  = 1;
8    $^W = 1;
9}
10
11use Test::More tests => 12;
12use File::Spec::Functions ':ALL';
13use File::Copy   ();
14use File::Remove ();
15
16
17
18
19
20#####################################################################
21# Set up for the test
22
23my $in = catdir( curdir(), 't' );
24ok( -d $in, 'Found t dir' );
25my $d1 = catdir( $in, 'd1' );
26my $d2 = catdir( $d1, 'd2' );
27my $f3 = catfile( $d2, 'f3.txt' );
28
29sub create_directory {
30    mkdir($d1,0777) or die "Failed to create $d1";
31    ok( -d $d1, "Created $d1 ok" );
32    ok( -r $d1, "Created $d1 -r" );
33    ok( -w $d1, "Created $d1 -w" );
34    mkdir($d2,0777) or die "Failed to create $d2";
35    ok( -d $d2, "Created $d2 ok" );
36    ok( -r $d2, "Created $d2 -r" );
37    ok( -w $d2, "Created $d2 -w" );
38    # Copy in a known-readonly file (in this case, the File::Spec lib we are using
39    File::Copy::copy( $INC{'File/Spec.pm'} => $f3 );
40    chmod( 0400, $f3 );
41    ok( -f $f3, "Created $f3 ok" );
42    ok( -r $f3, "Created $f3 -r" );
43    SKIP: {
44        if ( $^O ne 'MSWin32' and ($< == 0 or $> == 0) ) {
45            skip("This test doesn't work as root", 1);
46        }
47        if ( $^O eq 'cygwin' ) {
48            skip("Fails on some cygwin and shouldn't prevent install",1);
49        }
50        ok( ! -w $f3, "Created $f3 ! -w" );
51    };
52}
53
54sub clear_directory {
55    if ( -e $f3 ) {
56        chmod( 0700, $f3 ) or die "chmod 0700 $f3 failed";
57        unlink( $f3 )      or die "unlink: $f3 failed";
58        ! -e $f3           or die "unlink didn't work";
59    }
60    if ( -e $d2 ) {
61        rmdir( $d2 )       or die "rmdir: $d2 failed";
62        ! -e $d2           or die "rmdir didn't work";
63    }
64    if ( -e $d1 ) {
65        rmdir( $d1 )       or die "rmdir: $d1 failed";
66        ! -e $d1           or die "rmdir didn't work";
67    }
68}
69
70# Make sure there is no directory from a previous run
71clear_directory();
72
73# Create the directory
74create_directory();
75
76# Schedule cleanup
77END {
78    clear_directory();
79}
80
81
82
83
84
85#####################################################################
86# Main Testing
87
88# Call a recursive remove of the directory, nothing should be left after
89ok( File::Remove::remove( \1, $d1 ), "remove('$d1') ok" );
90ok( ! -e $d1, "Removed the directory ok" );
91