Commit | Line | Data |
f6d658cc |
1 | #!/usr/bin/perl -w |
2 | |
3 | # Test the private _can_write_dir() function. |
4 | |
5 | use strict; |
6 | use ExtUtils::Install; |
7 | use File::Spec; |
8 | { package FS; our @ISA = qw(File::Spec); } |
9 | |
10 | # Alias it for easier access |
11 | *can_write_dir = \&ExtUtils::Install::_can_write_dir; |
12 | |
13 | use Test::More 'no_plan'; |
14 | |
15 | |
16 | my $dne = FS->catdir(qw(does not exist)); |
17 | ok ! -e $dne; |
18 | is_deeply [can_write_dir($dne)], |
19 | [1, |
20 | FS->curdir, |
21 | FS->catdir('does'), |
22 | FS->catdir('does', 'not'), |
23 | FS->catdir('does', 'not', 'exist') |
24 | ]; |
25 | |
26 | |
27 | my $abs_dne = FS->rel2abs($dne); |
28 | ok ! -e $abs_dne; |
29 | is_deeply [can_write_dir($abs_dne)], |
30 | [1, |
31 | FS->rel2abs(FS->curdir), |
32 | FS->rel2abs(FS->catdir('does')), |
33 | FS->rel2abs(FS->catdir('does', 'not')), |
34 | FS->rel2abs(FS->catdir('does', 'not', 'exist')), |
35 | ]; |
36 | |
37 | |
38 | my $exists = FS->catdir(qw(exists)); |
39 | my $subdir = FS->catdir(qw(exists subdir)); |
40 | ok mkdir $exists; |
41 | END { rmdir $exists } |
42 | |
43 | ok chmod 0555, $exists, 'make read only'; |
44 | ok !-w $exists; |
45 | is_deeply [can_write_dir($exists)], [0, $exists]; |
46 | is_deeply [can_write_dir($subdir)], [0, $exists, $subdir]; |
47 | |
48 | ok chmod 0777, $exists, 'make writable'; |
49 | ok -w $exists; |
50 | is_deeply [can_write_dir($exists)], [1, $exists]; |
51 | is_deeply [can_write_dir($subdir)], |
52 | [1, |
53 | $exists, |
54 | $subdir |
55 | ]; |