t/io/open.t

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