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 | |
6170680b |
15 | { |
e620cd72 |
16 | unlink("afile") if -f "afile"; |
ad20d923 |
17 | |
18 | $! = 0; # the -f above will set $! if 'afile' doesn't exist. |
19 | ok( open(my $f,"+>afile"), 'open(my $f, "+>...")' ); |
20 | |
2c8ac474 |
21 | binmode $f; |
ad20d923 |
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' ); |
26 | |
2c8ac474 |
27 | $b = <$f>; |
ad20d923 |
28 | is( $b, "SomeData\n", ' readline' ); |
29 | ok( -f $f, ' still a file' ); |
30 | |
e620cd72 |
31 | eval { die "Message" }; |
ad20d923 |
32 | like( $@, qr/<\$f> line 1/, ' die message correct' ); |
33 | |
34 | ok( close($f), ' close()' ); |
35 | ok( unlink("afile"), ' unlink()' ); |
6170680b |
36 | } |
2c8ac474 |
37 | |
6170680b |
38 | { |
ad20d923 |
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' ); |
6170680b |
43 | } |
2c8ac474 |
44 | |
6170680b |
45 | { |
ad20d923 |
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' ); |
6170680b |
50 | } |
2c8ac474 |
51 | |
6170680b |
52 | { |
ad20d923 |
53 | ok( open(my $f, '<', 'afile'), "open(my \$f, '<', 'afile')" ); |
54 | my @rows = <$f>; |
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' ); |
6170680b |
59 | } |
2c8ac474 |
60 | |
6170680b |
61 | { |
ad20d923 |
62 | ok( -s 'afile' < 20, '-s' ); |
63 | |
64 | ok( open(my $f, '+<', 'afile'), 'open +<' ); |
65 | my @rows = <$f>; |
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' ); |
2c8ac474 |
71 | |
e620cd72 |
72 | unlink("afile"); |
2c8ac474 |
73 | } |
74 | |
ad20d923 |
75 | SKIP: { |
76 | skip "open -| busted and noisy on VMS", 3 if $Is_VMS; |
77 | |
78 | ok( open(my $f, '-|', <<EOC), 'open -|' ); |
79 | $^X -e "print qq(a row\n); print qq(another row\n)" |
6170680b |
80 | EOC |
2c8ac474 |
81 | |
ad20d923 |
82 | my @rows = <$f>; |
83 | is( scalar @rows, 2, ' readline, list context' ); |
84 | ok( close($f), ' close' ); |
2c8ac474 |
85 | } |
ad20d923 |
86 | |
87 | { |
88 | ok( open(my $f, '|-', <<EOC), 'open |-' ); |
89 | $^X -pe "s/^not //" |
6170680b |
90 | EOC |
ad20d923 |
91 | |
92 | my @rows = <$f>; |
93 | my $test = curr_test; |
94 | print $f "not ok $test - piped in\n"; |
95 | next_test; |
96 | |
97 | $test = curr_test; |
98 | print $f "not ok $test - piped in\n"; |
99 | next_test; |
100 | ok( close($f), ' close' ); |
2c8ac474 |
101 | sleep 1; |
ad20d923 |
102 | pass('flushing'); |
6170680b |
103 | } |
3eb568f1 |
104 | |
2c8ac474 |
105 | |
ad20d923 |
106 | ok( !eval { open my $f, '<&', 'afile'; 1; }, '<& on a non-filehandle' ); |
107 | like( $@, qr/Bad filehandle:\s+afile/, ' right error' ); |
2c8ac474 |
108 | |
ad20d923 |
109 | |
110 | # local $file tests |
2c8ac474 |
111 | { |
e620cd72 |
112 | unlink("afile") if -f "afile"; |
ad20d923 |
113 | |
114 | ok( open(local $f,"+>afile"), 'open local $f, "+>", ...' ); |
2c8ac474 |
115 | binmode $f; |
ad20d923 |
116 | |
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' ); |
121 | |
2c8ac474 |
122 | $b = <$f>; |
ad20d923 |
123 | is( $b, "SomeData\n", ' readline' ); |
124 | ok( -f $f, ' still a file' ); |
125 | |
e620cd72 |
126 | eval { die "Message" }; |
ad20d923 |
127 | like( $@, qr/<\$f> line 1/, ' proper die message' ); |
128 | ok( close($f), ' close' ); |
129 | |
e620cd72 |
130 | unlink("afile"); |
2c8ac474 |
131 | } |
132 | |
2c8ac474 |
133 | { |
ad20d923 |
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' ); |
2c8ac474 |
138 | } |
139 | |
2c8ac474 |
140 | { |
ad20d923 |
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' ); |
2c8ac474 |
145 | } |
146 | |
2c8ac474 |
147 | { |
ad20d923 |
148 | ok( open(local $f, '<', 'afile'), 'open local $f, "<", ...' ); |
149 | my @rows = <$f>; |
150 | is( scalar @rows, 2, ' readline list context' ); |
151 | ok( close($f), ' close' ); |
2c8ac474 |
152 | } |
153 | |
ad20d923 |
154 | ok( -s 'afile' < 20, ' -s' ); |
155 | |
2c8ac474 |
156 | { |
ad20d923 |
157 | ok( open(local $f, '+<', 'afile'), 'open local $f, "+<", ...' ); |
158 | my @rows = <$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' ); |
2c8ac474 |
164 | |
e620cd72 |
165 | unlink("afile"); |
2c8ac474 |
166 | } |
167 | |
ad20d923 |
168 | SKIP: { |
169 | skip "open -| busted and noisy on VMS", 3 if $Is_VMS; |
170 | |
171 | ok( open(local $f, '-|', <<EOC), 'open local $f, "-|", ...' ); |
172 | $^X -e "print qq(a row\n); print qq(another row\n)" |
2c8ac474 |
173 | EOC |
ad20d923 |
174 | my @rows = <$f>; |
2c8ac474 |
175 | |
ad20d923 |
176 | is( scalar @rows, 2, ' readline list context' ); |
177 | ok( close($f), ' close' ); |
2c8ac474 |
178 | } |
ad20d923 |
179 | |
180 | { |
181 | ok( open(local $f, '|-', <<EOC), 'open local $f, "|-", ...' ); |
182 | $^X -pe "s/^not //" |
2c8ac474 |
183 | EOC |
ad20d923 |
184 | |
185 | my @rows = <$f>; |
186 | my $test = curr_test; |
187 | print $f "not ok $test - piping\n"; |
188 | next_test; |
189 | |
190 | $test = curr_test; |
191 | print $f "not ok $test - piping\n"; |
192 | next_test; |
193 | ok( close($f), ' close' ); |
2c8ac474 |
194 | sleep 1; |
ad20d923 |
195 | pass("Flush"); |
2c8ac474 |
196 | } |
197 | |
faecd977 |
198 | |
ad20d923 |
199 | ok( !eval { open local $f, '<&', 'afile'; 1 }, 'local <& on non-filehandle'); |
200 | like( $@, qr/Bad filehandle:\s+afile/, ' right error' ); |
201 | |
202 | |
faecd977 |
203 | { |
204 | local *F; |
ed2efe3e |
205 | for (1..2) { |
ad20d923 |
206 | ok( open(F, qq{$^X -le "print 'ok'"|}), 'open to pipe' ); |
207 | is(scalar <F>, "ok\n", ' readline'); |
208 | ok( close F, ' close' ); |
ed2efe3e |
209 | } |
ad20d923 |
210 | |
ed2efe3e |
211 | for (1..2) { |
ad20d923 |
212 | ok( open(F, "-|", qq{$^X -le "print 'ok'"}), 'open -|'); |
213 | is( scalar <F>, "ok\n", ' readline'); |
214 | ok( close F, ' close' ); |
ed2efe3e |
215 | } |
faecd977 |
216 | } |
f6c77cf1 |
217 | |
ad20d923 |
218 | # magic temporary file via 3 arg open with undef |
f6c77cf1 |
219 | { |
ad20d923 |
220 | ok( open(my $x,"+<",undef), 'magic temp file via 3 arg open with undef'); |
221 | ok( defined fileno($x), ' fileno' ); |
222 | |
f6c77cf1 |
223 | select $x; |
ad20d923 |
224 | ok( (print "ok\n"), ' print' ); |
225 | |
f6c77cf1 |
226 | select STDOUT; |
ad20d923 |
227 | ok( seek($x,0,0), ' seek' ); |
228 | is( scalar <$x>, "ok\n", ' readline' ); |
229 | ok( tell($x) >= 3, ' tell' ); |
f6c77cf1 |
230 | } |