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