home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / t / io / open.t < prev    next >
Text File  |  2000-03-13  |  5KB  |  283 lines

  1. #!./perl
  2.  
  3. BEGIN {
  4.     chdir 't' if -d 't';
  5.     unshift @INC, '../lib';
  6. }    
  7.  
  8. # $RCSfile$    
  9. $|  = 1;
  10. use warnings;
  11. $Is_VMS = $^O eq 'VMS';
  12.  
  13. print "1..66\n";
  14.  
  15. my $test = 1;
  16.  
  17. sub ok { print "ok $test\n"; $test++ }
  18.  
  19. # my $file tests
  20.  
  21. # 1..9
  22. {
  23.     unlink("afile") if -f "afile";     
  24.     print "$!\nnot " unless open(my $f,"+>afile");
  25.     ok;
  26.     binmode $f;
  27.     print "not " unless -f "afile";     
  28.     ok;
  29.     print "not " unless print $f "SomeData\n";
  30.     ok;
  31.     print "not " unless tell($f) == 9;
  32.     ok;
  33.     print "not " unless seek($f,0,0);
  34.     ok;
  35.     $b = <$f>;
  36.     print "not " unless $b eq "SomeData\n";
  37.     ok;
  38.     print "not " unless -f $f;     
  39.     ok;
  40.     eval  { die "Message" };   
  41.     # warn $@;
  42.     print "not " unless $@ =~ /<\$f> line 1/;
  43.     ok;
  44.     print "not " unless close($f);
  45.     ok;
  46.     unlink("afile");     
  47. }
  48.  
  49. # 10..12
  50. {
  51.     print "# \$!='$!'\nnot " unless open(my $f,'>', 'afile');
  52.     ok;
  53.     print $f "a row\n";
  54.     print "not " unless close($f);
  55.     ok;
  56.     print "not " unless -s 'afile' < 10;
  57.     ok;
  58. }
  59.  
  60. # 13..15
  61. {
  62.     print "# \$!='$!'\nnot " unless open(my $f,'>>', 'afile');
  63.     ok;
  64.     print $f "a row\n";
  65.     print "not " unless close($f);
  66.     ok;
  67.     print "not " unless -s 'afile' > 10;
  68.     ok;
  69. }
  70.  
  71. # 16..18
  72. {
  73.     print "# \$!='$!'\nnot " unless open(my $f, '<', 'afile');
  74.     ok;
  75.     @rows = <$f>;
  76.     print "not " unless @rows == 2;
  77.     ok;
  78.     print "not " unless close($f);
  79.     ok;
  80. }
  81.  
  82. # 19..23
  83. {
  84.     print "not " unless -s 'afile' < 20;
  85.     ok;
  86.     print "# \$!='$!'\nnot " unless open(my $f, '+<', 'afile');
  87.     ok;
  88.     @rows = <$f>;
  89.     print "not " unless @rows == 2;
  90.     ok;
  91.     seek $f, 0, 1;
  92.     print $f "yet another row\n";
  93.     print "not " unless close($f);
  94.     ok;
  95.     print "not " unless -s 'afile' > 20;
  96.     ok;
  97.  
  98.     unlink("afile");     
  99. }
  100.  
  101. # 24..26
  102. if ($Is_VMS) {
  103.     for (24..26) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
  104. }
  105. else {
  106.     print "# \$!='$!'\nnot " unless open(my $f, '-|', <<'EOC');
  107.     ./perl -e "print qq(a row\n); print qq(another row\n)"
  108. EOC
  109.     ok;
  110.     @rows = <$f>;
  111.     print "not " unless @rows == 2;
  112.     ok;
  113.     print "not " unless close($f);
  114.     ok;
  115. }
  116.  
  117. # 27..30
  118. if ($Is_VMS) {
  119.     for (27..30) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
  120. }
  121. else {
  122.     print "# \$!='$!'\nnot " unless open(my $f, '|-', <<'EOC');
  123.     ./perl -pe "s/^not //"
  124. EOC
  125.     ok;
  126.     @rows = <$f>;
  127.     print $f "not ok $test\n"; $test++;
  128.     print $f "not ok $test\n"; $test++;
  129.     print "#\nnot " unless close($f);
  130.     sleep 1;
  131.     ok;
  132. }
  133.  
  134. # 31..32
  135. eval <<'EOE' and print "not ";
  136. open my $f, '<&', 'afile';
  137. 1;
  138. EOE
  139. ok;
  140. $@ =~ /Unknown open\(\) mode \'<&\'/ or print "not ";
  141. ok;
  142.  
  143. # local $file tests
  144.  
  145. # 33..41
  146. {
  147.     unlink("afile") if -f "afile";     
  148.     print "$!\nnot " unless open(local $f,"+>afile");
  149.     ok;
  150.     binmode $f;
  151.     print "not " unless -f "afile";     
  152.     ok;
  153.     print "not " unless print $f "SomeData\n";
  154.     ok;
  155.     print "not " unless tell($f) == 9;
  156.     ok;
  157.     print "not " unless seek($f,0,0);
  158.     ok;
  159.     $b = <$f>;
  160.     print "not " unless $b eq "SomeData\n";
  161.     ok;
  162.     print "not " unless -f $f;     
  163.     ok;
  164.     eval  { die "Message" };   
  165.     # warn $@;
  166.     print "not " unless $@ =~ /<\$f> line 1/;
  167.     ok;
  168.     print "not " unless close($f);
  169.     ok;
  170.     unlink("afile");     
  171. }
  172.  
  173. # 42..44
  174. {
  175.     print "# \$!='$!'\nnot " unless open(local $f,'>', 'afile');
  176.     ok;
  177.     print $f "a row\n";
  178.     print "not " unless close($f);
  179.     ok;
  180.     print "not " unless -s 'afile' < 10;
  181.     ok;
  182. }
  183.  
  184. # 45..47
  185. {
  186.     print "# \$!='$!'\nnot " unless open(local $f,'>>', 'afile');
  187.     ok;
  188.     print $f "a row\n";
  189.     print "not " unless close($f);
  190.     ok;
  191.     print "not " unless -s 'afile' > 10;
  192.     ok;
  193. }
  194.  
  195. # 48..50
  196. {
  197.     print "# \$!='$!'\nnot " unless open(local $f, '<', 'afile');
  198.     ok;
  199.     @rows = <$f>;
  200.     print "not " unless @rows == 2;
  201.     ok;
  202.     print "not " unless close($f);
  203.     ok;
  204. }
  205.  
  206. # 51..55
  207. {
  208.     print "not " unless -s 'afile' < 20;
  209.     ok;
  210.     print "# \$!='$!'\nnot " unless open(local $f, '+<', 'afile');
  211.     ok;
  212.     @rows = <$f>;
  213.     print "not " unless @rows == 2;
  214.     ok;
  215.     seek $f, 0, 1;
  216.     print $f "yet another row\n";
  217.     print "not " unless close($f);
  218.     ok;
  219.     print "not " unless -s 'afile' > 20;
  220.     ok;
  221.  
  222.     unlink("afile");     
  223. }
  224.  
  225. # 56..58
  226. if ($Is_VMS) {
  227.     for (56..58) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
  228. }
  229. else {
  230.     print "# \$!='$!'\nnot " unless open(local $f, '-|', <<'EOC');
  231.     ./perl -e "print qq(a row\n); print qq(another row\n)"
  232. EOC
  233.     ok;
  234.     @rows = <$f>;
  235.     print "not " unless @rows == 2;
  236.     ok;
  237.     print "not " unless close($f);
  238.     ok;
  239. }
  240.  
  241. # 59..62
  242. if ($Is_VMS) {
  243.     for (59..62) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
  244. }
  245. else {
  246.     print "# \$!='$!'\nnot " unless open(local $f, '|-', <<'EOC');
  247.     ./perl -pe "s/^not //"
  248. EOC
  249.     ok;
  250.     @rows = <$f>;
  251.     print $f "not ok $test\n"; $test++;
  252.     print $f "not ok $test\n"; $test++;
  253.     print "#\nnot " unless close($f);
  254.     sleep 1;
  255.     ok;
  256. }
  257.  
  258. # 63..64
  259. eval <<'EOE' and print "not ";
  260. open local $f, '<&', 'afile';
  261. 1;
  262. EOE
  263. ok;
  264. $@ =~ /Unknown open\(\) mode \'<&\'/ or print "not ";
  265. ok;
  266.  
  267. # 65..66
  268. {
  269.     local *F;
  270.     for (1..2) {
  271.         open(F, "echo #foo|") or print "not ";
  272.     print <F>;
  273.     close F;
  274.     }
  275.     ok;
  276.     for (1..2) {
  277.     open(F, "-|", "echo #foo") or print "not ";
  278.     print <F>;
  279.     close F;
  280.     }
  281.     ok;
  282. }
  283.