2 # Copyright (C) 2006-2008, Parrot Foundation.
7 use lib qw( . lib ../lib ../../lib );
10 use Parrot::Test tests => 17;
11 use Parrot::Test::Util 'create_tempfile';
12 use Parrot::Test::Util 'create_tempfile';
16 t/pmc/filehandle.t - test the FileHandle PMC
20 % prove t/pmc/filehandle.t
24 Tests the FileHandle PMC.
28 # L<PDD22/I\/O PMC API/=item new>
29 pir_output_is( <<'CODE', <<'OUT', 'new' );
31 $P0 = new ['FileHandle']
32 say "ok 1 - $P0 = new ['FileHandle']"
35 ok 1 - $P0 = new ['FileHandle']
38 my (undef, $temp_file) = create_tempfile( UNLINK => 1 );
40 # L<PDD22/I\/O PMC API/=item open.*=item close>
41 pir_output_is( <<"CODE", <<'OUT', 'open and close - synchronous' );
43 \$P1 = new ['FileHandle']
45 say 'ok 1 - \$P1.open(\$S1)'
48 say 'ok 2 - \$P1.close()'
50 \$P3 = new ['FileHandle']
51 \$P3.'open'('$temp_file', 'rw')
52 say 'ok 3 - \$P3.open(\$S1, \$S2) # rw mode'
56 say 'ok 4 - \$P3.open() # reopening'
60 \$P5 = new ['FileHandle']
62 \$P5.'open'('bad.file')
66 \$P6 = new ['FileHandle']
68 \$P6.'open'('bad.file', 'r')
72 \$P7 = new ['FileHandle']
73 \$P7.'open'('$temp_file', 'w')
74 say 'ok 7 - \$P7.open(\$S1, \$S2) # new file, write mode succeeds'
79 say 'ok 5 - \$P5.open(\$S1) # with bad file'
83 say "ok 6 - \$P6.open(\$S1, \$S2) # with bad file"
91 ok 3 - $P3.open($S1, $S2) # rw mode
92 ok 4 - $P3.open() # reopening
93 ok 5 - $P5.open($S1) # with bad file
94 ok 6 - $P6.open($S1, $S2) # with bad file
95 ok 7 - $P7.open($S1, $S2) # new file, write mode succeeds
98 # RT #46827 test open file, close file, delete file, reopen previously opened stream
101 skip 'no asynch calls yet' => 1;
103 pir_output_is( <<'CODE', <<'OUT', 'open and close - asynchronous' );
105 $P1 = # RT #46831 create a callback here
106 $P0 = new ['FileHandle']
109 say 'ok 1 - $P0.open($S1)'
112 say 'ok 2 - $P0.close($P1)'
114 $P0.'open'('README', 'rw')
115 say 'ok 3 - $P0.open($S1, $S2)'
119 say 'ok 4 - $P0.open()'
127 ok 3 - $P0.open($S1, $S2)
132 # L<PDD22/I\/O PMC API/=item read>
134 <<'CODE', <<'OUT', 'read - synchronous' );
136 $P0 = new ['FileHandle']
139 $S0 = $P0.'read'(14) # bytes
140 if $S0 == 'This is Parrot' goto ok_1
143 say 'ok 1 - $S0 = $P1.read($I2)'
145 $S0 = $P0.'read'(9) # bytes
146 if $S0 == ', version' goto ok_2
149 say 'ok 2 - $S0 = $P1.read($I2) # again on same stream'
152 ok 1 - $S0 = $P1.read($I2)
153 ok 2 - $S0 = $P1.read($I2) # again on same stream
156 # L<PDD22/I\/O PMC API/=item print>
157 pir_output_is( <<"CODE", <<'OUT', 'print - synchronous' );
160 \$P0 = new ['FileHandle']
161 \$P0.'open'('$temp_file', 'w')
164 say 'ok 1 - \$P0.print(\$I1)'
165 \$P0.'print'(456.789)
166 say 'ok 2 - \$P0.print(\$N1)'
167 \$P0.'print'("squawk\\n")
168 say 'ok 3 - \$P0.print(\$S1)'
169 \$P1 = new ['Integer']
172 say 'ok 4 - \$P0.print(\$P1)'
176 \$P1 = new ['FileHandle']
177 \$P1.'open'('$temp_file', 'r')
179 \$S0 = \$P1.'read'(3) # bytes
180 if \$S0 == "123" goto ok_5
183 say 'ok 5 - read integer back from file'
185 \$S0 = \$P1.'read'(16) # bytes
186 if \$S0 == "456.789squawk\\n42" goto ok_6
191 say 'ok 6 - read string back from file'
196 ok 1 - $P0.print($I1)
197 ok 2 - $P0.print($N1)
198 ok 3 - $P0.print($S1)
199 ok 4 - $P0.print($P1)
200 ok 5 - read integer back from file
201 ok 6 - read string back from file
204 (undef, $temp_file) = create_tempfile( UNLINK => 1 );
206 # L<PDD22/I\/O PMC API/=item print.*=item readline>
207 pir_output_is( <<"CODE", <<'OUT', 'readline - synchronous' );
209 load_bytecode 'String/Utils.pbc'
211 chomp = get_global ['String';'Utils'], 'chomp'
213 \$P0 = new ['FileHandle']
214 \$P0.'open'('$temp_file', 'w')
215 \$P0.'print'("foobarbaz\\n42")
218 \$P1 = new ['FileHandle']
219 \$P1.'open'('$temp_file')
221 \$S0 = \$P1.'readline'()
223 if \$S0 == 'foobarbaz' goto ok_1
226 say 'ok 1 - \$S0 = \$P1.readline()'
228 \$S0 = \$P1.'readline'()
230 if \$S0 == '42' goto ok_2
233 say 'ok 2 - \$S0 = \$P1.readline() # again on same stream'
238 ok 1 - $S0 = $P1.readline()
239 ok 2 - $S0 = $P1.readline() # again on same stream
243 ($LINES, $temp_file) = create_tempfile( UNLINK => 1 );
245 for my $counter (1 .. 10000) {
246 print $LINES $counter, "\n";
250 pir_output_is( <<"CODE", <<'OUT', 'readline 10,000 lines' );
252 load_bytecode 'String/Utils.pbc'
254 chomp = get_global ['String';'Utils'], 'chomp'
255 .local string test_line
256 .local pmc filehandle
258 filehandle = new ['FileHandle']
259 filehandle.'open'('$temp_file')
264 # read in the file one line at a time...
265 \$I0 = filehandle.'eof'()
266 if \$I0 goto end_read_loop
268 test_line = readline filehandle
269 if test_line == "" goto end_read_loop
270 test_line = chomp( test_line )
272 if \$I1 == counter goto read_loop
274 ## the following lines provide more extensive debugging
275 ## output on a readline failure
284 if counter > 1 goto read_something
287 say 'ok 1 - read 10,000 lines'
291 ok 1 - read 10,000 lines
295 # RT #46833 test reading/writing code points once supported
297 # RT #46835 test reading long chunks, eof, and across newlines
299 # RT #46837 pir_output_is( <<'CODE', <<'OUT', 'print, read, and readline - asynchronous', todo => 'not yet implemented' );
301 # L<PDD22/I\/O PMC API/=item record_separator>
302 pir_output_is( <<'CODE', <<'OUT', 'record_separator', todo => 'not yet implemented' );
304 $P0 = new ['FileHandle']
306 $S0 = $P0.'record_separator'()
307 if $S0 == "\n" goto ok_1
310 say 'ok 1 - $S0 = $P1.record_separator() # default'
313 $P0.'record_separator'($S99)
314 $S0 = $P0.'record_separator'()
315 if $S0 == $S99 goto ok_2
318 say 'ok 2 - $P0.record_separator($S1)'
321 $S0 = $P0.'record_separator'()
325 $S0 = $P0.'readline'()
326 if $S0 == '123abc' goto ok_3
329 say 'ok 3 - $P0.record_separator() # .readline works as expected'
332 ok 1 - $S0 = $P1.record_separator() # default
333 ok 2 - $P0.record_separator($S1)
334 ok 3 - $P0.record_separator() # .readline works as expected
337 # L<PDD22/I\/O PMC API/=item buffer_type>
338 pir_output_is( <<'CODE', <<'OUT', 'buffer_type' );
340 $P0 = new ['FileHandle']
342 $P0.'buffer_type'('unbuffered')
343 $S0 = $P0.'buffer_type'()
344 if $S0 == 'unbuffered' goto ok_1
347 say 'ok 1 - $S0 = $P1.buffer_type() # unbuffered'
349 $P0.'buffer_type'('line-buffered')
350 $S0 = $P0.'buffer_type'()
351 if $S0 == 'line-buffered' goto ok_2
354 say 'ok 2 - $S0 = $P1.buffer_type() # line-buffered'
356 $P0.'buffer_type'('full-buffered')
357 $S0 = $P0.'buffer_type'()
358 if $S0 == 'full-buffered' goto ok_3
361 say 'ok 3 - $S0 = $P1.buffer_type() # full-buffered'
365 ok 1 - $S0 = $P1.buffer_type() # unbuffered
366 ok 2 - $S0 = $P1.buffer_type() # line-buffered
367 ok 3 - $S0 = $P1.buffer_type() # full-buffered
370 # RT #46839 test effects of buffer_type, not just set/get
373 # L<PDD22/I\/O PMC API/=item buffer_size>
374 # NOTES: try setting positive, zero, negative int
375 # perform print and read ops
376 # change buffer size while it contains data
377 # try with all 'buffer_type' modes
379 (undef, $temp_file) = create_tempfile( UNLINK => 1 );
381 pir_output_is( <<"CODE", <<'OUT', 'buffer_size' );
383 \$P0 = new ['FileHandle']
385 \$P0.'buffer_type'('full-buffered')
386 \$P0.'buffer_size'(42)
387 say 'ok 1 - \$P0.buffer_size(42) # set buffer size'
389 \$I0 = \$P0.'buffer_size'()
391 # The set buffer size is a minimum, the I/O subsystem may scale it upward
392 # to a round block, so test that the buffer size is equal or greater than
394 if \$I0 >= 42 goto ok_2
397 say 'ok 2 - \$I0 = \$P0.buffer_size() # get buffer size'
399 \$P0.'open'('$temp_file', 'w')
401 \$P0.'print'(1234567890)
404 \$P1 = new ['FileHandle']
405 \$P1.'open'('$temp_file')
407 \$S0 = \$P1.'readline'()
409 if \$S0 == '1234567890' goto ok_3
412 say 'ok 3 - \$S0 = \$P0.readline() # buffer flushed'
418 ok 1 - $P0.buffer_size(42) # set buffer size
419 ok 2 - $I0 = $P0.buffer_size() # get buffer size
420 ok 3 - $S0 = $P0.readline() # buffer flushed
423 # L<PDD22/I\/O PMC API/=item encoding>
424 pir_output_is( <<'CODE', <<'OUT', 'encoding' );
426 $P0 = new ['FileHandle']
428 $P0.'encoding'('utf8')
429 $S0 = $P0.'encoding'()
430 if $S0 == 'utf8' goto ok_1
433 say 'ok 1 - $S0 = $P1.encoding() # utf8'
437 ok 1 - $S0 = $P1.encoding() # utf8
440 (undef, $temp_file) = create_tempfile( UNLINK => 1 );
442 pir_output_is( <<"CODE", <<'OUT', 'encoding - read/write' );
444 \$P0 = new ['FileHandle']
445 \$P0.'encoding'('utf8')
447 \$P0.'open'('$temp_file', 'w')
449 \$P0.'print'(1234567890)
451 \$S0 = iso-8859-1:"TÖTSCH"
455 \$P1 = new ['FileHandle']
456 \$P1.'encoding'('utf8')
458 \$P1.'open'('$temp_file')
460 \$S1 = \$P1.'readline'()
461 if \$S1 == "1234567890\\n" goto ok_1
465 say 'ok 1 - \$S1 = \$P1.readline() # read with utf8 encoding on'
467 \$S2 = \$P1.'readline'()
468 if \$S2 == \$S0 goto ok_2
472 say 'ok 2 - \$S2 = \$P1.readline() # read iso-8859-1 string'
478 ok 1 - $S1 = $P1.readline() # read with utf8 encoding on
479 ok 2 - $S2 = $P1.readline() # read iso-8859-1 string
483 (undef, $temp_file) = create_tempfile( UNLINK => 1 );
485 # L<PDD22/I\/O PMC API/=item mode>
486 pir_output_is( <<'CODE', <<'OUT', 'mode' );
488 $P0 = new ['FileHandle']
493 if $S0 == 'r' goto ok_1
496 say 'ok 1 - $S0 = $P0.mode() # get read mode'
502 ok 1 - $S0 = $P0.mode() # get read mode
505 pir_output_is( <<"CODE", <<"OUTPUT", "readall - closed filehandle" );
513 pio = new ['FileHandle']
514 pio.'open'("$temp_file", "w")
517 pio2 = new ['FileHandle']
518 \$S1 = pio2.'readall'('$temp_file')
519 if \$S0 == \$S1 goto ok
528 pir_output_is( <<"CODE", <<"OUTPUT", "readall() - opened filehandle" );
536 pio = new ['FileHandle']
537 pio.'open'("$temp_file", "w")
541 pio2 = new ['FileHandle']
542 pio2.'open'("$temp_file", "r")
543 \$S1 = pio2.'readall'()
544 if \$S0 == \$S1 goto ok
553 pir_output_is( <<"CODE", <<"OUTPUT", "readall() - utf8 on closed filehandle" );
556 ifh = new ['FileHandle']
557 ifh.'encoding'('utf8')
559 \$S0 = ifh.'readall'('$temp_file')
562 \$S1 = encodingname \$I0
570 pir_output_is( <<"CODE", <<"OUTPUT", "readall() - utf8 on opened filehandle" );
573 ifh = new ['FileHandle']
574 ifh.'encoding'('utf8')
575 ifh.'open'('$temp_file')
577 \$S0 = ifh.'readall'()
580 \$S1 = encodingname \$I0
589 # L<PDD22/I\/O PMC API/=item get_fd>
590 # NOTES: this is going to be platform dependent
594 # cperl-indent-level: 4
597 # vim: expandtab shiftwidth=4: