t/io/open.t

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