File: 04_can_delete.t

package info (click to toggle)
libfile-remove-perl 1.60-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye, sid
  • size: 240 kB
  • sloc: perl: 836; makefile: 2
file content (113 lines) | stat: -rw-r--r-- 2,507 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
#!/usr/bin/perl

# Test that File::Remove can recursively remove a directory that
# deeply contains a readonly file that is owned by the current user.
use strict;
use warnings;

use Test::More tests => 12;
use File::Spec::Functions ':ALL';
use File::Copy   ();
use File::Remove ();

#####################################################################
# Set up for the test

my $in = catdir( curdir(), 't', "04_can_delete-t.tmp" );
mkdir($in);

# TEST
ok( -d $in, 'Found t dir' );
my $d1 = catdir( $in, 'd1' );
my $d2 = catdir( $d1, 'd2' );
my $f3 = catfile( $d2, 'f3.txt' );

sub create_directory
{
    mkdir( $d1, 0777 ) or die "Failed to create $d1";

    # TEST
    ok( -d $d1, "Created $d1 ok" );

    # TEST
    ok( -r $d1, "Created $d1 -r" );

    # TEST
    ok( -w $d1, "Created $d1 -w" );
    mkdir( $d2, 0777 ) or die "Failed to create $d2";

    # TEST
    ok( -d $d2, "Created $d2 ok" );

    # TEST
    ok( -r $d2, "Created $d2 -r" );

    # TEST
    ok( -w $d2, "Created $d2 -w" );

  # Copy in a known-readonly file (in this case, the File::Spec lib we are using
    File::Copy::copy( $INC{'File/Spec.pm'} => $f3 );
    chmod( 0400, $f3 );

    # TEST
    ok( -f $f3, "Created $f3 ok" );

    # TEST
    ok( -r $f3, "Created $f3 -r" );
SKIP:
    {
        if ( $^O ne 'MSWin32' and $< == 0 )
        {
            skip( "This test doesn't work as root", 1 );
        }
        if ( $^O eq 'cygwin' )
        {
            skip( "Fails on some cygwin and shouldn't prevent install", 1 );
        }

        # TEST
        ok( !-w $f3, "Created $f3 ! -w" );
    }
}

sub clear_directory
{
    if ( -e $f3 )
    {
        chmod( 0700, $f3 ) or die "chmod 0700 $f3 failed";
        unlink($f3)        or die "unlink: $f3 failed";
        !-e $f3            or die "unlink didn't work";
    }
    if ( -e $d2 )
    {
        rmdir($d2) or die "rmdir: $d2 failed";
        !-e $d2    or die "rmdir didn't work";
    }
    if ( -e $d1 )
    {
        rmdir($d1) or die "rmdir: $d1 failed";
        !-e $d1    or die "rmdir didn't work";
    }
}

# Make sure there is no directory from a previous run
clear_directory();

# Create the directory
create_directory();

# Schedule cleanup
END
{
    clear_directory();
}

#####################################################################
# Main Testing

# Call a recursive remove of the directory, nothing should be left after
# TEST
is_deeply( [ File::Remove::remove($f3) ], [$f3], "remove('$f3') ok" );

# TEST
ok( !-e $f3, "Removed the file ok" );