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}