11 $Is_VMS = $^O eq 'VMS';
16 unlink("afile") if -f "afile";
18 $! = 0; # the -f above will set $! if 'afile' doesn't exist.
19 ok( open(my $f,"+>afile"), 'open(my $f, "+>...")' );
22 ok( -f "afile", ' its a file');
23 ok( (print $f "SomeData\n"), ' we can print to it');
24 is( tell($f), 9, ' tell()' );
25 ok( seek($f,0,0), ' seek set' );
28 is( $b, "SomeData\n", ' readline' );
29 ok( -f $f, ' still a file' );
31 eval { die "Message" };
32 like( $@, qr/<\$f> line 1/, ' die message correct' );
34 ok( close($f), ' close()' );
35 ok( unlink("afile"), ' unlink()' );
39 ok( open(my $f,'>', 'afile'), "open(my \$f, '>', 'afile')" );
40 ok( (print $f "a row\n"), ' print');
41 ok( close($f), ' close' );
42 ok( -s 'afile' < 10, ' -s' );
46 ok( open(my $f,'>>', 'afile'), "open(my \$f, '>>', 'afile')" );
47 ok( (print $f "a row\n"), ' print' );
48 ok( close($f), ' close' );
49 ok( -s 'afile' > 10, ' -s' );
53 ok( open(my $f, '<', 'afile'), "open(my \$f, '<', 'afile')" );
55 is( scalar @rows, 2, ' readline, list context' );
56 is( $rows[0], "a row\n", ' first line read' );
57 is( $rows[1], "a row\n", ' second line' );
58 ok( close($f), ' close' );
62 ok( -s 'afile' < 20, '-s' );
64 ok( open(my $f, '+<', 'afile'), 'open +<' );
66 is( scalar @rows, 2, ' readline, list context' );
67 ok( seek($f, 0, 1), ' seek cur' );
68 ok( (print $f "yet another row\n"), ' print' );
69 ok( close($f), ' close' );
70 ok( -s 'afile' > 20, ' -s' );
76 skip "open -| busted and noisy on VMS", 3 if $Is_VMS;
78 ok( open(my $f, '-|', <<EOC), 'open -|' );
79 $^X -e "print qq(a row\n); print qq(another row\n)"
83 is( scalar @rows, 2, ' readline, list context' );
84 ok( close($f), ' close' );
88 ok( open(my $f, '|-', <<EOC), 'open |-' );
94 print $f "not ok $test - piped in\n";
98 print $f "not ok $test - piped in\n";
100 ok( close($f), ' close' );
106 ok( !eval { open my $f, '<&', 'afile'; 1; }, '<& on a non-filehandle' );
107 like( $@, qr/Bad filehandle:\s+afile/, ' right error' );
112 unlink("afile") if -f "afile";
114 ok( open(local $f,"+>afile"), 'open local $f, "+>", ...' );
117 ok( -f "afile", ' -f' );
118 ok( (print $f "SomeData\n"), ' print' );
119 is( tell($f), 9, ' tell' );
120 ok( seek($f,0,0), ' seek set' );
123 is( $b, "SomeData\n", ' readline' );
124 ok( -f $f, ' still a file' );
126 eval { die "Message" };
127 like( $@, qr/<\$f> line 1/, ' proper die message' );
128 ok( close($f), ' close' );
134 ok( open(local $f,'>', 'afile'), 'open local $f, ">", ...' );
135 ok( (print $f "a row\n"), ' print');
136 ok( close($f), ' close');
137 ok( -s 'afile' < 10, ' -s' );
141 ok( open(local $f,'>>', 'afile'), 'open local $f, ">>", ...' );
142 ok( (print $f "a row\n"), ' print');
143 ok( close($f), ' close');
144 ok( -s 'afile' > 10, ' -s' );
148 ok( open(local $f, '<', 'afile'), 'open local $f, "<", ...' );
150 is( scalar @rows, 2, ' readline list context' );
151 ok( close($f), ' close' );
154 ok( -s 'afile' < 20, ' -s' );
157 ok( open(local $f, '+<', 'afile'), 'open local $f, "+<", ...' );
159 is( scalar @rows, 2, ' readline list context' );
160 ok( seek($f, 0, 1), ' seek cur' );
161 ok( (print $f "yet another row\n"), ' print' );
162 ok( close($f), ' close' );
163 ok( -s 'afile' > 20, ' -s' );
169 skip "open -| busted and noisy on VMS", 3 if $Is_VMS;
171 ok( open(local $f, '-|', <<EOC), 'open local $f, "-|", ...' );
172 $^X -e "print qq(a row\n); print qq(another row\n)"
176 is( scalar @rows, 2, ' readline list context' );
177 ok( close($f), ' close' );
181 ok( open(local $f, '|-', <<EOC), 'open local $f, "|-", ...' );
186 my $test = curr_test;
187 print $f "not ok $test - piping\n";
191 print $f "not ok $test - piping\n";
193 ok( close($f), ' close' );
199 ok( !eval { open local $f, '<&', 'afile'; 1 }, 'local <& on non-filehandle');
200 like( $@, qr/Bad filehandle:\s+afile/, ' right error' );
206 ok( open(F, qq{$^X -le "print 'ok'"|}), 'open to pipe' );
207 is(scalar <F>, "ok\n", ' readline');
208 ok( close F, ' close' );
212 ok( open(F, "-|", qq{$^X -le "print 'ok'"}), 'open -|');
213 is( scalar <F>, "ok\n", ' readline');
214 ok( close F, ' close' );
218 # magic temporary file via 3 arg open with undef
220 ok( open(my $x,"+<",undef), 'magic temp file via 3 arg open with undef');
221 ok( defined fileno($x), ' fileno' );
224 ok( (print "ok\n"), ' print' );
227 ok( seek($x,0,0), ' seek' );
228 is( scalar <$x>, "ok\n", ' readline' );
229 ok( tell($x) >= 3, ' tell' );