lib/ExtUtils/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 }