t/op/lfs.t

   1 BEGIN {
   2         eval { pack "q", 0 };
   3         if ($@) {
   4                 print "1..0\n# no 64-bit types\n";
   5                 exit(0);
   6         }
   7 }
   8
   9 # First try to figure out whether we have sparse files.
  10
  11 if ($^O eq 'win32' || $^O eq 'vms') {
  12     print "1..0\n# no sparse files\n";
  13     exit(0);
  14 }
  15
  16 open(BIG, ">big");
  17 close(BIG);
  18
  19 my @s;
  20
  21 @s = stat("big");
  22
  23 unless (@s == 13 && defined $s[11] && defined $s[12]) {
  24     print "1..0\n# no sparse files\n";
  25     exit(0);
  26 }
  27
  28 # By now we better be sure that we do have sparse files:
  29 # if we are not, the following will hog 5 gigabytes of disk.  Ooops.
  30
  31 print "1..8\n";
  32
  33 open(BIG, ">big");
  34 binmode BIG;
  35 seek(BIG, 5_000_000_000, 0);
  36 print BIG "big";
  37 close BIG;
  38
  39 @s = stat("big");
  40
  41 print "not " unless $s[7] == 5_000_000_003;
  42 print "ok 1\n";
  43
  44 print "not " unless -s "big" == 5_000_000_003;
  45 print "ok 2\n";
  46
  47 open(BIG, "big");
  48 binmode BIG;
  49
  50 seek(BIG, 4_500_000_000, 0);
  51
  52 print "not " unless tell(BIG) == 4_500_000_000;
  53 print "ok 3\n";
  54
  55 seek(BIG, 1, 1);
  56
  57 print "not " unless tell(BIG) == 4_500_000_001;
  58 print "ok 4\n";
  59
  60 seek(BIG, -1, 1);
  61
  62 print "not " unless tell(BIG) == 4_500_000_000;
  63 print "ok 5\n";
  64
  65 seek(BIG, -3, 2);
  66
  67 print "not " unless tell(BIG) == 5_000_000_000;
  68 print "ok 6\n";
  69
  70 my $big;
  71
  72 print "not " unless read(BIG, $big, 3) == 3;
  73 print "ok 7\n";
  74
  75 print "not " unless $big eq "big";
  76 print "ok 8\n";
  77
  78 close(BIG);
  79
  80 # Testing sysseek() and other sys*() io would be nice but for
  81 # the tests to be be portable they require the SEEK_* constants.
  82
  83 unlink "big";
  84