1#!/usr/bin/perl -w
2
3# Test the private _can_write_dir() function.
4
5use strict;
6use ExtUtils::Install;
7use 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
13use Test::More 'no_plan';
14
15
16my $dne = FS->catdir(qw(does not exist));
17ok ! -e $dne;
18is_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
27my $abs_dne = FS->rel2abs($dne);
28ok ! -e $abs_dne;
29is_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
37SKIP: {
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}