test/statfs.t

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