Commit | Line | Data |
---|---|---|
f6d658cc YO |
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 SH |
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 | } |