ext/Fcntl/t/mode.t

   1 #!./perl -w
   2
   3 use Test::More;
   4
   5 use File::Temp;
   6 use File::Spec;
   7
   8 use Fcntl qw(:mode);
   9
  10 my $tmpfile = File::Temp->new;
  11 my @tests = (
  12              ['REG', 'tmpfile', (stat "$tmpfile")[2]],
  13              ['DIR', 'dir', (stat '.')[2]]
  14             );
  15
  16 $devnull = File::Spec->devnull();
  17 if (-c $devnull) {
  18     push @tests, ['CHR', $devnull, (stat $devnull)[2]];
  19 }
  20
  21 plan(tests => 34 + 6 + 9 * @tests);
  22 foreach (@tests) {
  23     my ($type, $name, $mode) = @$_;
  24
  25     if ($type eq 'REG') {
  26         ok( S_ISREG($mode), " S_ISREG $name");
  27     } else {
  28         ok(!S_ISREG($mode), "!S_ISREG $name");
  29     }
  30
  31     if ($type eq 'DIR') {
  32         ok( S_ISDIR($mode), " S_ISDIR $name");
  33     } else {
  34         ok(!S_ISDIR($mode), "!S_ISDIR $name");
  35     }
  36
  37  SKIP: {
  38         skip 'No S_IFCHR', 1 unless defined eval {S_IFCHR};
  39         if ($type eq 'CHR') {
  40             ok( S_ISCHR($mode), " S_ISCHR $name");
  41         } else {
  42             ok(!S_ISCHR($mode), "!S_ISCHR $name");
  43         }
  44     }
  45
  46  SKIP: {
  47         skip 'No S_IFLNK', 1 unless defined eval {S_IFLNK};
  48         ok(!S_ISLNK($mode), "!S_ISLNK $name");
  49     }
  50  SKIP: {
  51         skip 'No S_IFSOCK', 1 unless defined eval {S_IFSOCK};
  52         ok(!S_ISSOCK($mode), "!S_ISSOCK $name");
  53     }
  54  SKIP: {
  55         skip 'No S_IFBLK', 1 unless defined eval {S_IFBLK};
  56         ok(!S_ISBLK($mode), "!S_ISBLK $name");
  57     }
  58  SKIP: {
  59         skip 'No S_IFFIFO', 1 unless defined eval {S_IFFIFO};
  60         ok(!S_ISFIFO($mode), "!S_ISFIFO $name");
  61     }
  62  SKIP: {
  63         skip 'No S_IFWHT', 1 unless defined eval {S_IFWHT};
  64         ok(!S_ISWHT($mode), "!S_ISWHT $name");
  65     }
  66  SKIP: {
  67         skip 'No S_ENFMT', 1 unless defined eval {S_ENFMT};
  68         ok(!S_ISENFMT($mode), "!S_ISENFMT $name");
  69     }
  70 }
  71
  72 foreach ([S_ISREG => \&S_ISREG],
  73          [S_IMODE => \&S_IMODE],
  74         ) {
  75     my ($name, $func) = @$_;
  76     my @warnings;
  77     my $ret;
  78
  79     {
  80         local $SIG{__WARN__} = sub { push @warnings, "@_" };
  81         $ret = &$func();
  82     }
  83     ok(!$ret, "$name() is false");
  84     is(scalar @warnings, 1, '1 warning');
  85     like($warnings[0], qr/^Use of uninitialized value/, 'expected warning');
  86 }
  87
  88 is (S_IFMT(), _S_IFMT(), 'S_IFMT()');
  89 is (S_IFMT(0), 0, 'S_IFMT(0)');
  90 for my $shift (0..31) {
  91     is (S_IFMT(1 << $shift), ((1 << $shift) & _S_IFMT()), "S_IFMT(1 << $shift)");
  92 }