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; |
35066d42 |
11 | use Config; |
821b8a23 |
12 | $Is_VMS = $^O eq 'VMS'; |
3eb568f1 |
13 | |
35066d42 |
14 | plan tests => 94; |
2c8ac474 |
15 | |
b5fe401b |
16 | my $Perl = which_perl(); |
17 | |
6170680b |
18 | { |
e620cd72 |
19 | unlink("afile") if -f "afile"; |
ad20d923 |
20 | |
21 | $! = 0; # the -f above will set $! if 'afile' doesn't exist. |
22 | ok( open(my $f,"+>afile"), 'open(my $f, "+>...")' ); |
23 | |
2c8ac474 |
24 | binmode $f; |
ad20d923 |
25 | ok( -f "afile", ' its a file'); |
26 | ok( (print $f "SomeData\n"), ' we can print to it'); |
27 | is( tell($f), 9, ' tell()' ); |
28 | ok( seek($f,0,0), ' seek set' ); |
29 | |
2c8ac474 |
30 | $b = <$f>; |
ad20d923 |
31 | is( $b, "SomeData\n", ' readline' ); |
32 | ok( -f $f, ' still a file' ); |
33 | |
e620cd72 |
34 | eval { die "Message" }; |
ad20d923 |
35 | like( $@, qr/<\$f> line 1/, ' die message correct' ); |
36 | |
37 | ok( close($f), ' close()' ); |
38 | ok( unlink("afile"), ' unlink()' ); |
6170680b |
39 | } |
2c8ac474 |
40 | |
6170680b |
41 | { |
ad20d923 |
42 | ok( open(my $f,'>', 'afile'), "open(my \$f, '>', 'afile')" ); |
43 | ok( (print $f "a row\n"), ' print'); |
44 | ok( close($f), ' close' ); |
45 | ok( -s 'afile' < 10, ' -s' ); |
6170680b |
46 | } |
2c8ac474 |
47 | |
6170680b |
48 | { |
ad20d923 |
49 | ok( open(my $f,'>>', 'afile'), "open(my \$f, '>>', 'afile')" ); |
50 | ok( (print $f "a row\n"), ' print' ); |
51 | ok( close($f), ' close' ); |
52 | ok( -s 'afile' > 10, ' -s' ); |
6170680b |
53 | } |
2c8ac474 |
54 | |
6170680b |
55 | { |
ad20d923 |
56 | ok( open(my $f, '<', 'afile'), "open(my \$f, '<', 'afile')" ); |
57 | my @rows = <$f>; |
58 | is( scalar @rows, 2, ' readline, list context' ); |
59 | is( $rows[0], "a row\n", ' first line read' ); |
60 | is( $rows[1], "a row\n", ' second line' ); |
61 | ok( close($f), ' close' ); |
6170680b |
62 | } |
2c8ac474 |
63 | |
6170680b |
64 | { |
ad20d923 |
65 | ok( -s 'afile' < 20, '-s' ); |
66 | |
67 | ok( open(my $f, '+<', 'afile'), 'open +<' ); |
68 | my @rows = <$f>; |
69 | is( scalar @rows, 2, ' readline, list context' ); |
70 | ok( seek($f, 0, 1), ' seek cur' ); |
71 | ok( (print $f "yet another row\n"), ' print' ); |
72 | ok( close($f), ' close' ); |
73 | ok( -s 'afile' > 20, ' -s' ); |
2c8ac474 |
74 | |
e620cd72 |
75 | unlink("afile"); |
2c8ac474 |
76 | } |
77 | |
ad20d923 |
78 | SKIP: { |
79 | skip "open -| busted and noisy on VMS", 3 if $Is_VMS; |
80 | |
81 | ok( open(my $f, '-|', <<EOC), 'open -|' ); |
b5fe401b |
82 | $Perl -e "print qq(a row\n); print qq(another row\n)" |
6170680b |
83 | EOC |
2c8ac474 |
84 | |
ad20d923 |
85 | my @rows = <$f>; |
86 | is( scalar @rows, 2, ' readline, list context' ); |
87 | ok( close($f), ' close' ); |
2c8ac474 |
88 | } |
ad20d923 |
89 | |
90 | { |
91 | ok( open(my $f, '|-', <<EOC), 'open |-' ); |
b5fe401b |
92 | $Perl -pe "s/^not //" |
6170680b |
93 | EOC |
ad20d923 |
94 | |
95 | my @rows = <$f>; |
96 | my $test = curr_test; |
97 | print $f "not ok $test - piped in\n"; |
98 | next_test; |
99 | |
100 | $test = curr_test; |
101 | print $f "not ok $test - piped in\n"; |
102 | next_test; |
103 | ok( close($f), ' close' ); |
2c8ac474 |
104 | sleep 1; |
ad20d923 |
105 | pass('flushing'); |
6170680b |
106 | } |
3eb568f1 |
107 | |
2c8ac474 |
108 | |
ad20d923 |
109 | ok( !eval { open my $f, '<&', 'afile'; 1; }, '<& on a non-filehandle' ); |
110 | like( $@, qr/Bad filehandle:\s+afile/, ' right error' ); |
2c8ac474 |
111 | |
ad20d923 |
112 | |
113 | # local $file tests |
2c8ac474 |
114 | { |
e620cd72 |
115 | unlink("afile") if -f "afile"; |
ad20d923 |
116 | |
117 | ok( open(local $f,"+>afile"), 'open local $f, "+>", ...' ); |
2c8ac474 |
118 | binmode $f; |
ad20d923 |
119 | |
120 | ok( -f "afile", ' -f' ); |
121 | ok( (print $f "SomeData\n"), ' print' ); |
122 | is( tell($f), 9, ' tell' ); |
123 | ok( seek($f,0,0), ' seek set' ); |
124 | |
2c8ac474 |
125 | $b = <$f>; |
ad20d923 |
126 | is( $b, "SomeData\n", ' readline' ); |
127 | ok( -f $f, ' still a file' ); |
128 | |
e620cd72 |
129 | eval { die "Message" }; |
ad20d923 |
130 | like( $@, qr/<\$f> line 1/, ' proper die message' ); |
131 | ok( close($f), ' close' ); |
132 | |
e620cd72 |
133 | unlink("afile"); |
2c8ac474 |
134 | } |
135 | |
2c8ac474 |
136 | { |
ad20d923 |
137 | ok( open(local $f,'>', 'afile'), 'open local $f, ">", ...' ); |
138 | ok( (print $f "a row\n"), ' print'); |
139 | ok( close($f), ' close'); |
140 | ok( -s 'afile' < 10, ' -s' ); |
2c8ac474 |
141 | } |
142 | |
2c8ac474 |
143 | { |
ad20d923 |
144 | ok( open(local $f,'>>', 'afile'), 'open local $f, ">>", ...' ); |
145 | ok( (print $f "a row\n"), ' print'); |
146 | ok( close($f), ' close'); |
147 | ok( -s 'afile' > 10, ' -s' ); |
2c8ac474 |
148 | } |
149 | |
2c8ac474 |
150 | { |
ad20d923 |
151 | ok( open(local $f, '<', 'afile'), 'open local $f, "<", ...' ); |
152 | my @rows = <$f>; |
153 | is( scalar @rows, 2, ' readline list context' ); |
154 | ok( close($f), ' close' ); |
2c8ac474 |
155 | } |
156 | |
ad20d923 |
157 | ok( -s 'afile' < 20, ' -s' ); |
158 | |
2c8ac474 |
159 | { |
ad20d923 |
160 | ok( open(local $f, '+<', 'afile'), 'open local $f, "+<", ...' ); |
161 | my @rows = <$f>; |
162 | is( scalar @rows, 2, ' readline list context' ); |
163 | ok( seek($f, 0, 1), ' seek cur' ); |
164 | ok( (print $f "yet another row\n"), ' print' ); |
165 | ok( close($f), ' close' ); |
166 | ok( -s 'afile' > 20, ' -s' ); |
2c8ac474 |
167 | |
e620cd72 |
168 | unlink("afile"); |
2c8ac474 |
169 | } |
170 | |
ad20d923 |
171 | SKIP: { |
172 | skip "open -| busted and noisy on VMS", 3 if $Is_VMS; |
173 | |
174 | ok( open(local $f, '-|', <<EOC), 'open local $f, "-|", ...' ); |
b5fe401b |
175 | $Perl -e "print qq(a row\n); print qq(another row\n)" |
2c8ac474 |
176 | EOC |
ad20d923 |
177 | my @rows = <$f>; |
2c8ac474 |
178 | |
ad20d923 |
179 | is( scalar @rows, 2, ' readline list context' ); |
180 | ok( close($f), ' close' ); |
2c8ac474 |
181 | } |
ad20d923 |
182 | |
183 | { |
184 | ok( open(local $f, '|-', <<EOC), 'open local $f, "|-", ...' ); |
b5fe401b |
185 | $Perl -pe "s/^not //" |
2c8ac474 |
186 | EOC |
ad20d923 |
187 | |
188 | my @rows = <$f>; |
189 | my $test = curr_test; |
190 | print $f "not ok $test - piping\n"; |
191 | next_test; |
192 | |
193 | $test = curr_test; |
194 | print $f "not ok $test - piping\n"; |
195 | next_test; |
196 | ok( close($f), ' close' ); |
2c8ac474 |
197 | sleep 1; |
ad20d923 |
198 | pass("Flush"); |
2c8ac474 |
199 | } |
200 | |
faecd977 |
201 | |
ad20d923 |
202 | ok( !eval { open local $f, '<&', 'afile'; 1 }, 'local <& on non-filehandle'); |
203 | like( $@, qr/Bad filehandle:\s+afile/, ' right error' ); |
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 | |
04dd828a |
220 | |
221 | # other dupping techniques |
222 | { |
223 | ok( open(my $stdout, ">&", \*STDOUT), 'dup \*STDOUT into lexical fh'); |
224 | ok( open(STDOUT, ">&", $stdout), 'restore dupped STDOUT from lexical fh'); |
225 | } |
226 | |
35066d42 |
227 | SKIP: { |
228 | skip "This perl uses perlio", 1 if $Config{useperlio}; |
229 | skip "This system doesn't understand EINVAL", 1 unless exists $!{EINVAL}; |
230 | |
aaac28e4 |
231 | no warnings 'io'; |
35066d42 |
232 | ok( !open(F,'>',\my $s) && $!{EINVAL}, 'open(reference) raises EINVAL' ); |
233 | } |
234 | |
235 | { |
236 | ok( !eval { open F, "BAR", "QUUX" }, 'Unknown open() mode' ); |
237 | like( $@, qr/\QUnknown open() mode 'BAR'/, ' right error' ); |
238 | } |