t/io/open.t

   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 }