test/statfs.t

   1 #!/usr/bin/perl
   2 use test::helper qw($_real $_point);
   3 use Test::More;
   4 use Config;
   5
   6 my $has_Filesys__Statvfs = 0;
   7 eval {
   8     require Filesys::Statvfs;
   9     1;
  10 } and do {
  11     $has_Filesys__Statvfs = 1;
  12     Filesys::Statvfs->import();
  13 };
  14
  15 my $has_syscall = 0;
  16 eval {
  17    require 'sys/syscall.ph'; # for SYS_statfs
  18    1;
  19 } and do {
  20     $has_syscall = 1;
  21 };
  22
  23 if (!($has_syscall || $has_Filesys__Statvfs)) {
  24     plan skip_all => 'No Filesys::Statvfs and no sys/syscall.ph';
  25 }
  26
  27 # Maybe not the best way to do this... but it works. Only extract the values
  28 # we care about, so we don't have to worry about changing field ordering
  29 # around and other such nastiness.
  30 my $packmask;
  31 # Don't even bother setting up a packmask if we have Filesys::Statvfs.
  32 # In that case, we can just make one call, and save ourselves a ton of
  33 # messing around.
  34 if (!$has_Filesys__Statvfs) {
  35     if ($^O eq 'linux') {
  36         $packmask = 'x[L!]L![6]x[L]x[L]L';
  37     }
  38     elsif ($^O eq 'freebsd') {
  39         $packmask = 'x[16]Qx[8]Q[2]qQqx[112]Lx[4]';
  40     }
  41     elsif ($^O eq 'netbsd') {
  42         if ($Config{'use64bitint'}) {
  43             # This should work for any 64-bit NetBSD...
  44             $packmask = 'x[8]Lx![q]x[16]Q[3]x[8]Q[2]x[64]L';
  45         }
  46         else {
  47             # NetBSD's perl on 32-bit doesn't handle quadword types, and
  48             # this is my workaround. Ugly, but it does the job. And yes,
  49             # won't work for big values. Good thing we're not testing
  50             # with any, huh?
  51             if ($Config{'byteorder'} eq '1234') { # little endian
  52                 $packmask = 'x[4]Lx[8]Lx[4]Lx[4]Lx[4]x[8]Lx[4]Lx[4]x[64]L';
  53             }
  54             elsif ($Config{'byteorder'} eq '4321') { # big endian
  55                 $packmask = 'x[4]Lx[8]x[4]Lx[4]Lx[4]Lx[8]x[4]Lx[4]Lx[64]L';
  56             }
  57             else {
  58                 plan skip_all => "Word ordering not known, don't know how to handle statvfs1()";
  59                 exit(1);
  60             }
  61         }
  62     }
  63     elsif ($^O eq 'darwin') {
  64         # Accurate for OS X 10.6; 10.5 and earlier may not actually correspond
  65         # to this, if my understanding of statfs(2) on OS X is fair.
  66         $packmask = 'x[L!]L!x[L!]L![5]';
  67     }
  68     else {
  69         plan skip_all => 'Platform not known, need to know how to statfs';
  70         exit(1);
  71     }
  72 }
  73
  74 if ($^O eq 'netbsd' || $^O eq 'darwin') {
  75     # Ignoring the f_namelen field; no such animal on OS X statfs(), and
  76         # NetBSD's statvfs1(2) syscall doesn't seem to handle f_namelen right
  77         # for PUFFS-based filesystems. Not our failure, and mostly irrelevant.
  78     plan tests => 6;
  79 }
  80 else {
  81     plan tests => 7;
  82 }
  83 my @list;
  84 if ($has_Filesys__Statvfs) {
  85     # This is a neater way to do this - if it's available...
  86     ok(@list = (statvfs($_point))[1,2,3,4,5,6,9]);
  87 }
  88 elsif ($has_syscall) {
  89     # Just make the buffer large enough that we don't have to care...
  90     my ($statfs_data) = "\0" x 4096;
  91     my ($tmp) = $_point;
  92     if ($^O eq 'netbsd') {
  93         # NetBSD doesn't have statfs(2); statvfs1(2) is its closest analogue.
  94         ok(!syscall(&SYS_statvfs1,$tmp,$statfs_data,1),'statvfs1');
  95     }
  96     else {
  97         ok(!syscall(&SYS_statfs,$tmp,$statfs_data),'statfs');
  98     }
  99     @list = unpack($packmask,$statfs_data);
 100 }
 101 diag "statfs: ",join(', ', @list);
 102 is(shift(@list),4096,'block size');
 103 is(shift(@list),1000000,'blocks');
 104 is(shift(@list),500000,'blocks free');
 105 shift(@list);
 106 is(shift(@list),1000000,'files');
 107 is(shift(@list),500000,'files free');
 108 unless ($^O eq 'netbsd' || $^O eq 'darwin') {
 109     is(shift(@list),255,'namelen');
 110 }