home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / t / lib / syslfs.t < prev    next >
Text File  |  2000-03-02  |  6KB  |  222 lines
  1. # NOTE: this file tests how large files (>2GB) work with raw system IO.
  2. # stdio: open(), tell(), seek(), print(), read() is tested in t/op/lfs.t.
  3. # If you modify/add tests here, remember to update also t/op/lfs.t.
  4.  
  5. BEGIN {
  6.     chdir 't' if -d 't';
  7.     unshift @INC, '../lib';
  8.     require Config; import Config;
  9.     # Don't bother if there are no quad offsets.
  10.     if ($Config{lseeksize} < 8) {
  11.         print "1..0\n# no 64-bit file offsets\n";
  12.         exit(0);
  13.     }
  14.     require Fcntl; import Fcntl qw(/^O_/ /^SEEK_/);
  15. }
  16.  
  17. sub zap {
  18.     close(BIG);
  19.     unlink("big");
  20.     unlink("big1");
  21.     unlink("big2");
  22. }
  23.  
  24. sub bye {
  25.     zap(); 
  26.     exit(0);
  27. }
  28.  
  29. sub explain {
  30.     print <<EOM;
  31. #
  32. # If the lfs (large file support: large meaning larger than two gigabytes)
  33. # tests are skipped or fail, it may mean either that your process
  34. # (or process group) is not allowed to write large files (resource
  35. # limits) or that the file system you are running the tests on doesn't
  36. # let your user/group have large files (quota) or the filesystem simply
  37. # doesn't support large files.  You may even need to reconfigure your kernel.
  38. # (This is all very operating system and site-dependent.)
  39. #
  40. # Perl may still be able to support large files, once you have
  41. # such a process, enough quota, and such a (file) system.
  42. #
  43. EOM
  44. }
  45.  
  46. print "# checking whether we have sparse files...\n";
  47.  
  48. # Known have-nots.
  49. if ($^O eq 'win32' || $^O eq 'vms') {
  50.     print "1..0\n# no sparse files (because this is $^O) \n";
  51.     bye();
  52. }
  53.  
  54. # Known haves that have problems running this test
  55. # (for example because they do not support sparse files, like UNICOS)
  56. if ($^O eq 'unicos') {
  57.     print "1..0\n# large files known to work but unable to test them here ($^O)\n";
  58.     bye();
  59. }
  60.  
  61. # Then try heuristically to deduce whether we have sparse files.
  62.  
  63. # We'll start off by creating a one megabyte file which has
  64. # only three "true" bytes.  If we have sparseness, we should
  65. # consume less blocks than one megabyte (assuming nobody has
  66. # one megabyte blocks...)
  67.  
  68. sysopen(BIG, "big1", O_WRONLY|O_CREAT|O_TRUNC) or
  69.     do { warn "sysopen big1 failed: $!\n"; bye };
  70. sysseek(BIG, 1_000_000, SEEK_SET) or
  71.     do { warn "sysseek big1 failed: $!\n"; bye };
  72. syswrite(BIG, "big") or
  73.     do { warn "syswrite big1 failed; $!\n"; bye };
  74. close(BIG) or
  75.     do { warn "close big1 failed: $!\n"; bye };
  76.  
  77. my @s1 = stat("big1");
  78.  
  79. print "# s1 = @s1\n";
  80.  
  81. sysopen(BIG, "big2", O_WRONLY|O_CREAT|O_TRUNC) or
  82.     do { warn "sysopen big2 failed: $!\n"; bye };
  83. sysseek(BIG, 2_000_000, SEEK_SET) or
  84.     do { warn "sysseek big2 failed: $!\n"; bye };
  85. syswrite(BIG, "big") or
  86.     do { warn "syswrite big2 failed; $!\n"; bye };
  87. close(BIG) or
  88.     do { warn "close big2 failed: $!\n"; bye };
  89.  
  90. my @s2 = stat("big2");
  91.  
  92. print "# s2 = @s2\n";
  93.  
  94. zap();
  95.  
  96. unless ($s1[7] == 1_000_003 && $s2[7] == 2_000_003 &&
  97.     $s1[11] == $s2[11] && $s1[12] == $s2[12]) {
  98.     print "1..0\n#no sparse files?\n";
  99.     bye;
  100. }
  101.  
  102. print "# we seem to have sparse files...\n";
  103.  
  104. # By now we better be sure that we do have sparse files:
  105. # if we are not, the following will hog 5 gigabytes of disk.  Ooops.
  106.  
  107. $ENV{LC_ALL} = "C";
  108.  
  109. sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or
  110.     do { warn "sysopen 'big' failed: $!\n"; bye };
  111. my $sysseek = sysseek(BIG, 5_000_000_000, SEEK_SET);
  112. unless (defined $sysseek && $sysseek == 5_000_000_000) {
  113.     print "1..0\n# seeking past 2GB failed: $! (sysseek returned ",
  114.           defined $sysseek ? $sysseek : 'undef', ")\n";
  115.     explain();
  116.     bye();
  117. }
  118.  
  119. # The syswrite will fail if there are are filesize limitations (process or fs).
  120. my $syswrite = syswrite(BIG, "big");
  121. print "# syswrite failed: $! (syswrite returned ",
  122.       defined $syswrite ? $syswrite : 'undef', ")\n"
  123.     unless defined $syswrite && $syswrite == 3;
  124. my $close     = close BIG;
  125. print "# close failed: $!\n" unless $close;
  126. unless($syswrite && $close) {
  127.     if ($! =~/too large/i) {
  128.     print "1..0\n# writing past 2GB failed: process limits?\n";
  129.     } elsif ($! =~ /quota/i) {
  130.     print "1..0\n# filesystem quota limits?\n";
  131.     }
  132.     explain();
  133.     bye();
  134. }
  135.  
  136. @s = stat("big");
  137.  
  138. print "# @s\n";
  139.  
  140. unless ($s[7] == 5_000_000_003) {
  141.     print "1..0\n# not configured to use large files?\n";
  142.     explain();
  143.     bye();
  144. }
  145.  
  146. sub fail () {
  147.     print "not ";
  148.     $fail++;
  149. }
  150.  
  151. print "1..17\n";
  152.  
  153. my $fail = 0;
  154.  
  155. fail unless $s[7] == 5_000_000_003;    # exercizes pp_stat
  156. print "ok 1\n";
  157.  
  158. fail unless -s "big" == 5_000_000_003;    # exercizes pp_ftsize
  159. print "ok 2\n";
  160.  
  161. fail unless -e "big";
  162. print "ok 3\n";
  163.  
  164. fail unless -f "big";
  165. print "ok 4\n";
  166.  
  167. sysopen(BIG, "big", O_RDONLY) or do { warn "sysopen failed: $!\n"; bye };
  168.  
  169. fail unless sysseek(BIG, 4_500_000_000, SEEK_SET) == 4_500_000_000;
  170. print "ok 5\n";
  171.  
  172. fail unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_000;
  173. print "ok 6\n";
  174.  
  175. fail unless sysseek(BIG, 1, SEEK_CUR) == 4_500_000_001;
  176. print "ok 7\n";
  177.  
  178. fail unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_001;
  179. print "ok 8\n";
  180.  
  181. fail unless sysseek(BIG, -1, SEEK_CUR) == 4_500_000_000;
  182. print "ok 9\n";
  183.  
  184. fail unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_000;
  185. print "ok 10\n";
  186.  
  187. fail unless sysseek(BIG, -3, SEEK_END) == 5_000_000_000;
  188. print "ok 11\n";
  189.  
  190. fail unless sysseek(BIG, 0, SEEK_CUR) == 5_000_000_000;
  191. print "ok 12\n";
  192.  
  193. my $big;
  194.  
  195. fail unless sysread(BIG, $big, 3) == 3;
  196. print "ok 13\n";
  197.  
  198. fail unless $big eq "big";
  199. print "ok 14\n";
  200.  
  201. # 705_032_704 = (I32)5_000_000_000
  202. fail unless seek(BIG, 705_032_704, SEEK_SET);
  203. print "ok 15\n";
  204.  
  205. my $zero;
  206.  
  207. fail unless read(BIG, $zero, 3) == 3;
  208. print "ok 16\n";
  209.  
  210. fail unless $zero eq "\0\0\0";
  211. print "ok 17\n";
  212.  
  213. explain if $fail;
  214.  
  215. bye(); # does the necessary cleanup
  216.  
  217. END {
  218.    unlink "big"; # be paranoid about leaving 5 gig files lying around
  219. }
  220.  
  221. # eof
  222.