This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Refactor porting/diag.t and improve output format
[perl5.git] / dist / ExtUtils-Install / t / can_write_dir.t
CommitLineData
f6d658cc
YO
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
3f6d40bd
SH
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}