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 | |
3f6d40bd |
37 | SKIP: { |
38 | my $exists = FS->catdir(qw(exists)); |
39 | my $subdir = FS->catdir(qw(exists subdir)); |
40 | |
41 | |
42 | ok mkdir $exists; |
43 | END { rmdir $exists } |
44 | |
45 | ok chmod 0555, $exists, 'make read only'; |
46 | |
47 | skip "Current user or OS cannot create directories that they cannot read", 6 |
48 | if -w $exists; # these tests require a directory we cant read |
49 | |
50 | is_deeply [can_write_dir($exists)], [0, $exists]; |
51 | is_deeply [can_write_dir($subdir)], [0, $exists, $subdir]; |
52 | |
53 | ok chmod 0777, $exists, 'make writable'; |
54 | ok -w $exists; |
55 | is_deeply [can_write_dir($exists)], [1, $exists]; |
56 | is_deeply [can_write_dir($subdir)], |
57 | [1, |
58 | $exists, |
59 | $subdir |
60 | ]; |
61 | } |