home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / t / lib / filehand.t < prev    next >
Text File  |  1999-07-20  |  2KB  |  92 lines
  1. #!./perl
  2.  
  3. BEGIN {
  4.     chdir 't' if -d 't';
  5.     unshift @INC, '../lib';
  6.     require Config; import Config;
  7.     if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
  8.     print "1..0\n";
  9.     exit 0;
  10.     }
  11. }
  12.  
  13. use FileHandle;
  14. use strict subs;
  15.  
  16. autoflush STDOUT 1;
  17.  
  18. $mystdout = new_from_fd FileHandle 1,"w";
  19. $| = 1;
  20. autoflush $mystdout;
  21. print "1..11\n";
  22.  
  23. print $mystdout "ok ",fileno($mystdout),"\n";
  24.  
  25. $fh = (new FileHandle "./TEST", O_RDONLY
  26.        or new FileHandle "TEST", O_RDONLY)
  27.   and print "ok 2\n";
  28.  
  29.  
  30. $buffer = <$fh>;
  31. print $buffer eq "#!./perl\n" ? "ok 3\n" : "not ok 3\n";
  32.  
  33.  
  34. ungetc $fh ord 'A';
  35. CORE::read($fh, $buf,1);
  36. print $buf eq 'A' ? "ok 4\n" : "not ok 4\n";
  37.  
  38. close $fh;
  39.  
  40. $fh = new FileHandle;
  41.  
  42. print "not " unless ($fh->open("< TEST") && <$fh> eq $buffer);
  43. print "ok 5\n";
  44.  
  45. $fh->seek(0,0);
  46. print "#possible mixed CRLF/LF in t/TEST\nnot " unless (<$fh> eq $buffer);
  47. print "ok 6\n";
  48.  
  49. $fh->seek(0,2);
  50. $line = <$fh>;
  51. print "not " if (defined($line) || !$fh->eof);
  52. print "ok 7\n";
  53.  
  54. print "not " unless ($fh->open("TEST","r") && !$fh->tell && $fh->close);
  55. print "ok 8\n";
  56.  
  57. autoflush STDOUT 0;
  58.  
  59. print "not " if ($|);
  60. print "ok 9\n";
  61.  
  62. autoflush STDOUT 1;
  63.  
  64. print "not " unless ($|);
  65. print "ok 10\n";
  66.  
  67. if ($^O eq 'dos')
  68. {
  69.     printf("ok %d\n",11);
  70.     exit(0);
  71. }
  72.  
  73. ($rd,$wr) = FileHandle::pipe;
  74.  
  75. if ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
  76.     $Config{d_fork} ne 'define') {
  77.   $wr->autoflush;
  78.   $wr->printf("ok %d\n",11);
  79.   print $rd->getline;
  80. }
  81. else {
  82.   if (fork) {
  83.    $wr->close;
  84.    print $rd->getline;
  85.   }
  86.   else {
  87.    $rd->close;
  88.    $wr->printf("ok %d\n",11);
  89.    exit(0);
  90.   }
  91. }
  92.