11 $Is_VMS = $^O eq 'VMS';
15 my $Perl = which_perl();
18 unlink("afile") if -f "afile";
20 $! = 0; # the -f above will set $! if 'afile' doesn't exist.
21 ok( open(my $f,"+>afile"), 'open(my $f, "+>...")' );
24 ok( -f "afile", ' its a file');
25 ok( (print $f "SomeData\n"), ' we can print to it');
26 is( tell($f), 9, ' tell()' );
27 ok( seek($f,0,0), ' seek set' );
30 is( $b, "SomeData\n", ' readline' );
31 ok( -f $f, ' still a file' );
33 eval { die "Message" };
34 like( $@, qr/<\$f> line 1/, ' die message correct' );
36 ok( close($f), ' close()' );
37 ok( unlink("afile"), ' unlink()' );
41 ok( open(my $f,'>', 'afile'), "open(my \$f, '>', 'afile')" );
42 ok( (print $f "a row\n"), ' print');
43 ok( close($f), ' close' );
44 ok( -s 'afile' < 10, ' -s' );
48 ok( open(my $f,'>>', 'afile'), "open(my \$f, '>>', 'afile')" );
49 ok( (print $f "a row\n"), ' print' );
50 ok( close($f), ' close' );
51 ok( -s 'afile' > 10, ' -s' );
55 ok( open(my $f, '<', 'afile'), "open(my \$f, '<', 'afile')" );
57 is( scalar @rows, 2, ' readline, list context' );
58 is( $rows[0], "a row\n", ' first line read' );
59 is( $rows[1], "a row\n", ' second line' );
60 ok( close($f), ' close' );
64 ok( -s 'afile' < 20, '-s' );
66 ok( open(my $f, '+<', 'afile'), 'open +<' );
68 is( scalar @rows, 2, ' readline, list context' );
69 ok( seek($f, 0, 1), ' seek cur' );
70 ok( (print $f "yet another row\n"), ' print' );
71 ok( close($f), ' close' );
72 ok( -s 'afile' > 20, ' -s' );
78 skip "open -| busted and noisy on VMS", 3 if $Is_VMS;
80 ok( open(my $f, '-|', <<EOC), 'open -|' );
81 $Perl -e "print qq(a row\n); print qq(another row\n)"
85 is( scalar @rows, 2, ' readline, list context' );
86 ok( close($f), ' close' );
90 ok( open(my $f, '|-', <<EOC), 'open |-' );
96 print $f "not ok $test - piped in\n";
100 print $f "not ok $test - piped in\n";
102 ok( close($f), ' close' );
108 ok( !eval { open my $f, '<&', 'afile'; 1; }, '<& on a non-filehandle' );
109 like( $@, qr/Bad filehandle:\s+afile/, ' right error' );
114 unlink("afile") if -f "afile";
116 ok( open(local $f,"+>afile"), 'open local $f, "+>", ...' );
119 ok( -f "afile", ' -f' );
120 ok( (print $f "SomeData\n"), ' print' );
121 is( tell($f), 9, ' tell' );
122 ok( seek($f,0,0), ' seek set' );
125 is( $b, "SomeData\n", ' readline' );
126 ok( -f $f, ' still a file' );
128 eval { die "Message" };
129 like( $@, qr/<\$f> line 1/, ' proper die message' );
130 ok( close($f), ' close' );
136 ok( open(local $f,'>', 'afile'), 'open local $f, ">", ...' );
137 ok( (print $f "a row\n"), ' print');
138 ok( close($f), ' close');
139 ok( -s 'afile' < 10, ' -s' );
143 ok( open(local $f,'>>', 'afile'), 'open local $f, ">>", ...' );
144 ok( (print $f "a row\n"), ' print');
145 ok( close($f), ' close');
146 ok( -s 'afile' > 10, ' -s' );
150 ok( open(local $f, '<', 'afile'), 'open local $f, "<", ...' );
152 is( scalar @rows, 2, ' readline list context' );
153 ok( close($f), ' close' );
156 ok( -s 'afile' < 20, ' -s' );
159 ok( open(local $f, '+<', 'afile'), 'open local $f, "+<", ...' );
161 is( scalar @rows, 2, ' readline list context' );
162 ok( seek($f, 0, 1), ' seek cur' );
163 ok( (print $f "yet another row\n"), ' print' );
164 ok( close($f), ' close' );
165 ok( -s 'afile' > 20, ' -s' );
171 skip "open -| busted and noisy on VMS", 3 if $Is_VMS;
173 ok( open(local $f, '-|', <<EOC), 'open local $f, "-|", ...' );
174 $Perl -e "print qq(a row\n); print qq(another row\n)"
178 is( scalar @rows, 2, ' readline list context' );
179 ok( close($f), ' close' );
183 ok( open(local $f, '|-', <<EOC), 'open local $f, "|-", ...' );
184 $Perl -pe "s/^not //"
188 my $test = curr_test;
189 print $f "not ok $test - piping\n";
193 print $f "not ok $test - piping\n";
195 ok( close($f), ' close' );
201 ok( !eval { open local $f, '<&', 'afile'; 1 }, 'local <& on non-filehandle');
202 like( $@, qr/Bad filehandle:\s+afile/, ' right error' );
207 ok( open(F, qq{$Perl -le "print 'ok'"|}), 'open to pipe' );
208 is(scalar <F>, "ok\n", ' readline');
209 ok( close F, ' close' );
213 ok( open(F, "-|", qq{$Perl -le "print 'ok'"}), 'open -|');
214 is( scalar <F>, "ok\n", ' readline');
215 ok( close F, ' close' );
219 # magic temporary file via 3 arg open with undef
221 ok( open(my $x,"+<",undef), 'magic temp file via 3 arg open with undef');
222 ok( defined fileno($x), ' fileno' );
225 ok( (print "ok\n"), ' print' );
228 ok( seek($x,0,0), ' seek' );
229 is( scalar <$x>, "ok\n", ' readline' );
230 ok( tell($x) >= 3, ' tell' );