t/op/lfs.t

   1 # NOTE: this file tests how large files (>2GB) work with perlio (stdio/sfio).
   2 # sysopen(), sysseek(), syswrite(), sysread() are tested in t/lib/syslfs.t.
   3 # If you modify/add tests here, remember to update also t/lib/syslfs.t.
   4
   5 BEGIN {
   6         eval { my $q = pack "q", 0 };
   7         if ($@) {
   8                 print "1..0\n# no 64-bit types\n";
   9                 bye();
  10         }
  11         chdir 't' if -d 't';
  12         unshift @INC, '../lib';
  13 }
  14
  15 sub bye {
  16     close(BIG);
  17     unlink "big";
  18     exit(0);
  19 }
  20
  21 # First try to figure out whether we have sparse files.
  22
  23 if ($^O eq 'win32' || $^O eq 'vms') {
  24     print "1..0\n# no sparse files\n";
  25     bye();
  26 }
  27
  28 my ($SEEK_SET, $SEEK_CUR, $SEEK_END) = (0, 1, 2);
  29
  30 # We'll start off by creating a one megabyte file which has
  31 # only three "true" bytes.
  32
  33 open(BIG, ">big") or do { warn "open failed: $!\n"; bye };
  34 binmode BIG;
  35 seek(BIG, 1_000_000, $SEEK_SET);
  36 print BIG "big";
  37 close(BIG);
  38
  39 my @s;
  40
  41 @s = stat("big");
  42
  43 print "# @s\n";
  44
  45 unless (@s == 13 &&
  46         $s[7] == 1_000_003 &&
  47         defined $s[11] &&
  48         defined $s[12] &&
  49        $s[11] * $s[12] < 1000_003) {
  50     print "1..0\n# no sparse files?\n";
  51     bye();
  52 }
  53
  54 # By now we better be sure that we do have sparse files:
  55 # if we are not, the following will hog 5 gigabytes of disk.  Ooops.
  56
  57 print "1..8\n";
  58
  59 open(BIG, ">big") or do { warn "open failed: $!\n"; bye };
  60 binmode BIG;
  61 seek(BIG, 5_000_000_000, $SEEK_SET);
  62 print BIG "big";
  63 close BIG;
  64
  65 @s = stat("big");
  66
  67 print "# @s\n";
  68
  69 print "not " unless $s[7] == 5_000_000_003;
  70 print "ok 1\n";
  71
  72 print "not " unless -s "big" == 5_000_000_003;
  73 print "ok 2\n";
  74
  75 open(BIG, "big") or do { warn "open failed: $!\n"; bye };
  76 binmode BIG;
  77
  78 seek(BIG, 4_500_000_000, $SEEK_SET);
  79
  80 print "not " unless tell(BIG) == 4_500_000_000;
  81 print "ok 3\n";
  82
  83 seek(BIG, 1, $SEEK_CUR);
  84
  85 print "not " unless tell(BIG) == 4_500_000_001;
  86 print "ok 4\n";
  87
  88 seek(BIG, -1, $SEEK_CUR);
  89
  90 print "not " unless tell(BIG) == 4_500_000_000;
  91 print "ok 5\n";
  92
  93 seek(BIG, -3, $SEEK_END);
  94
  95 print "not " unless tell(BIG) == 5_000_000_000;
  96 print "ok 6\n";
  97
  98 my $big;
  99
 100 print "not " unless read(BIG, $big, 3) == 3;
 101 print "ok 7\n";
 102
 103 print "not " unless $big eq "big";
 104 print "ok 8\n";
 105
 106 bye();
 107
 108 # eof