Move ExtUtils::Install from ext/ to dist/
[perl.git] / dist / ExtUtils-Install / t / can_write_dir.t
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 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 }