Commit | Line | Data |
3eb568f1 |
1 | #!./perl |
2 | |
9f1b1f2d |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
20822f61 |
5 | @INC = '../lib'; |
ad20d923 |
6 | require './test.pl'; |
e620cd72 |
7 | } |
9f1b1f2d |
8 | |
853846ea |
9 | $| = 1; |
9f1b1f2d |
10 | use warnings; |
821b8a23 |
11 | $Is_VMS = $^O eq 'VMS'; |
3eb568f1 |
12 | |
ad20d923 |
13 | plan tests => 95; |
2c8ac474 |
14 | |
b5fe401b |
15 | my $Perl = which_perl(); |
16 | |
6170680b |
17 | { |
e620cd72 |
18 | unlink("afile") if -f "afile"; |
ad20d923 |
19 | |
20 | $! = 0; # the -f above will set $! if 'afile' doesn't exist. |
21 | ok( open(my $f,"+>afile"), 'open(my $f, "+>...")' ); |
22 | |
2c8ac474 |
23 | binmode $f; |
ad20d923 |
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' ); |
28 | |
2c8ac474 |
29 | $b = <$f>; |
ad20d923 |
30 | is( $b, "SomeData\n", ' readline' ); |
31 | ok( -f $f, ' still a file' ); |
32 | |
e620cd72 |
33 | eval { die "Message" }; |
ad20d923 |
34 | like( $@, qr/<\$f> line 1/, ' die message correct' ); |
35 | |
36 | ok( close($f), ' close()' ); |
37 | ok( unlink("afile"), ' unlink()' ); |
6170680b |
38 | } |
2c8ac474 |
39 | |
6170680b |
40 | { |
ad20d923 |
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' ); |
6170680b |
45 | } |
2c8ac474 |
46 | |
6170680b |
47 | { |
ad20d923 |
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' ); |
6170680b |
52 | } |
2c8ac474 |
53 | |
6170680b |
54 | { |
ad20d923 |
55 | ok( open(my $f, '<', 'afile'), "open(my \$f, '<', 'afile')" ); |
56 | my @rows = <$f>; |
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' ); |
6170680b |
61 | } |
2c8ac474 |
62 | |
6170680b |
63 | { |
ad20d923 |
64 | ok( -s 'afile' < 20, '-s' ); |
65 | |
66 | ok( open(my $f, '+<', 'afile'), 'open +<' ); |
67 | my @rows = <$f>; |
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' ); |
2c8ac474 |
73 | |
e620cd72 |
74 | unlink("afile"); |
2c8ac474 |
75 | } |
76 | |
ad20d923 |
77 | SKIP: { |
78 | skip "open -| busted and noisy on VMS", 3 if $Is_VMS; |
79 | |
80 | ok( open(my $f, '-|', <<EOC), 'open -|' ); |
b5fe401b |
81 | $Perl -e "print qq(a row\n); print qq(another row\n)" |
6170680b |
82 | EOC |
2c8ac474 |
83 | |
ad20d923 |
84 | my @rows = <$f>; |
85 | is( scalar @rows, 2, ' readline, list context' ); |
86 | ok( close($f), ' close' ); |
2c8ac474 |
87 | } |
ad20d923 |
88 | |
89 | { |
90 | ok( open(my $f, '|-', <<EOC), 'open |-' ); |
b5fe401b |
91 | $Perl -pe "s/^not //" |
6170680b |
92 | EOC |
ad20d923 |
93 | |
94 | my @rows = <$f>; |
95 | my $test = curr_test; |
96 | print $f "not ok $test - piped in\n"; |
97 | next_test; |
98 | |
99 | $test = curr_test; |
100 | print $f "not ok $test - piped in\n"; |
101 | next_test; |
102 | ok( close($f), ' close' ); |
2c8ac474 |
103 | sleep 1; |
ad20d923 |
104 | pass('flushing'); |
6170680b |
105 | } |
3eb568f1 |
106 | |
2c8ac474 |
107 | |
ad20d923 |
108 | ok( !eval { open my $f, '<&', 'afile'; 1; }, '<& on a non-filehandle' ); |
109 | like( $@, qr/Bad filehandle:\s+afile/, ' right error' ); |
2c8ac474 |
110 | |
ad20d923 |
111 | |
112 | # local $file tests |
2c8ac474 |
113 | { |
e620cd72 |
114 | unlink("afile") if -f "afile"; |
ad20d923 |
115 | |
116 | ok( open(local $f,"+>afile"), 'open local $f, "+>", ...' ); |
2c8ac474 |
117 | binmode $f; |
ad20d923 |
118 | |
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' ); |
123 | |
2c8ac474 |
124 | $b = <$f>; |
ad20d923 |
125 | is( $b, "SomeData\n", ' readline' ); |
126 | ok( -f $f, ' still a file' ); |
127 | |
e620cd72 |
128 | eval { die "Message" }; |
ad20d923 |
129 | like( $@, qr/<\$f> line 1/, ' proper die message' ); |
130 | ok( close($f), ' close' ); |
131 | |
e620cd72 |
132 | unlink("afile"); |
2c8ac474 |
133 | } |
134 | |
2c8ac474 |
135 | { |
ad20d923 |
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' ); |
2c8ac474 |
140 | } |
141 | |
2c8ac474 |
142 | { |
ad20d923 |
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' ); |
2c8ac474 |
147 | } |
148 | |
2c8ac474 |
149 | { |
ad20d923 |
150 | ok( open(local $f, '<', 'afile'), 'open local $f, "<", ...' ); |
151 | my @rows = <$f>; |
152 | is( scalar @rows, 2, ' readline list context' ); |
153 | ok( close($f), ' close' ); |
2c8ac474 |
154 | } |
155 | |
ad20d923 |
156 | ok( -s 'afile' < 20, ' -s' ); |
157 | |
2c8ac474 |
158 | { |
ad20d923 |
159 | ok( open(local $f, '+<', 'afile'), 'open local $f, "+<", ...' ); |
160 | my @rows = <$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' ); |
2c8ac474 |
166 | |
e620cd72 |
167 | unlink("afile"); |
2c8ac474 |
168 | } |
169 | |
ad20d923 |
170 | SKIP: { |
171 | skip "open -| busted and noisy on VMS", 3 if $Is_VMS; |
172 | |
173 | ok( open(local $f, '-|', <<EOC), 'open local $f, "-|", ...' ); |
b5fe401b |
174 | $Perl -e "print qq(a row\n); print qq(another row\n)" |
2c8ac474 |
175 | EOC |
ad20d923 |
176 | my @rows = <$f>; |
2c8ac474 |
177 | |
ad20d923 |
178 | is( scalar @rows, 2, ' readline list context' ); |
179 | ok( close($f), ' close' ); |
2c8ac474 |
180 | } |
ad20d923 |
181 | |
182 | { |
183 | ok( open(local $f, '|-', <<EOC), 'open local $f, "|-", ...' ); |
b5fe401b |
184 | $Perl -pe "s/^not //" |
2c8ac474 |
185 | EOC |
ad20d923 |
186 | |
187 | my @rows = <$f>; |
188 | my $test = curr_test; |
189 | print $f "not ok $test - piping\n"; |
190 | next_test; |
191 | |
192 | $test = curr_test; |
193 | print $f "not ok $test - piping\n"; |
194 | next_test; |
195 | ok( close($f), ' close' ); |
2c8ac474 |
196 | sleep 1; |
ad20d923 |
197 | pass("Flush"); |
2c8ac474 |
198 | } |
199 | |
faecd977 |
200 | |
ad20d923 |
201 | ok( !eval { open local $f, '<&', 'afile'; 1 }, 'local <& on non-filehandle'); |
202 | like( $@, qr/Bad filehandle:\s+afile/, ' right error' ); |
203 | |
204 | |
faecd977 |
205 | { |
206 | local *F; |
ed2efe3e |
207 | for (1..2) { |
b5fe401b |
208 | ok( open(F, qq{$Perl -le "print 'ok'"|}), 'open to pipe' ); |
ad20d923 |
209 | is(scalar <F>, "ok\n", ' readline'); |
210 | ok( close F, ' close' ); |
ed2efe3e |
211 | } |
ad20d923 |
212 | |
ed2efe3e |
213 | for (1..2) { |
b5fe401b |
214 | ok( open(F, "-|", qq{$Perl -le "print 'ok'"}), 'open -|'); |
ad20d923 |
215 | is( scalar <F>, "ok\n", ' readline'); |
216 | ok( close F, ' close' ); |
ed2efe3e |
217 | } |
faecd977 |
218 | } |
f6c77cf1 |
219 | |
ad20d923 |
220 | # magic temporary file via 3 arg open with undef |
f6c77cf1 |
221 | { |
ad20d923 |
222 | ok( open(my $x,"+<",undef), 'magic temp file via 3 arg open with undef'); |
223 | ok( defined fileno($x), ' fileno' ); |
224 | |
f6c77cf1 |
225 | select $x; |
ad20d923 |
226 | ok( (print "ok\n"), ' print' ); |
227 | |
f6c77cf1 |
228 | select STDOUT; |
ad20d923 |
229 | ok( seek($x,0,0), ' seek' ); |
230 | is( scalar <$x>, "ok\n", ' readline' ); |
231 | ok( tell($x) >= 3, ' tell' ); |
f6c77cf1 |
232 | } |