2 # Copyright (C) 2006-2010, Parrot Foundation.
7 use lib qw( . lib ../lib ../../lib );
10 use Parrot::Test tests => 23;
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' );
44 \$P1 = new ['FileHandle']
46 say 'ok 1 - \$P1.open(\$S1)'
49 say 'ok 2 - \$P1.close()'
51 \$P3 = new ['FileHandle']
52 \$P3.'open'('$temp_file', 'rw')
53 say 'ok 3 - \$P3.open(\$S1, \$S2) # rw mode'
57 say 'ok 4 - \$P3.open() # reopening'
61 \$P5 = new ['FileHandle']
63 \$P5.'open'('bad.file')
67 \$P6 = new ['FileHandle']
69 \$P6.'open'('bad.file', 'r')
73 \$P7 = new ['FileHandle']
74 \$P7.'open'('$temp_file', 'w')
75 say 'ok 7 - \$P7.open(\$S1, \$S2) # new file, write mode succeeds'
77 i = \$P7.'is_closed'()
81 i = \$P7.'is_closed'()
82 print 'is_closed after close: '
88 say 'ok 5 - \$P5.open(\$S1) # with bad file'
92 say "ok 6 - \$P6.open(\$S1, \$S2) # with bad file"
100 ok 3 - $P3.open($S1, $S2) # rw mode
101 ok 4 - $P3.open() # reopening
102 ok 5 - $P5.open($S1) # with bad file
103 ok 6 - $P6.open($S1, $S2) # with bad file
104 ok 7 - $P7.open($S1, $S2) # new file, write mode succeeds
106 is_closed after close: 1
109 pir_output_is( <<'CODE', <<'OUT', 'wrong open' );
110 .include 'except_types.pasm'
116 eh = new['ExceptionHandler']
117 eh = .EXCEPTION_PIO_ERROR
118 set_addr eh, catchnoname
120 fh = new['FileHandle']
121 # Open without filename
131 set_addr eh, catchreopen
134 # Open already opened
149 pir_output_is( <<'CODE', <<'OUT', 'isatty' );
153 fh = new ['FileHandle']
156 say ' unopened FileHandle is not a tty'
160 say ' regular file is not a tty'
163 0 unopened FileHandle is not a tty
164 0 regular file is not a tty
168 skip 'no asynch calls yet' => 1;
170 pir_output_is( <<'CODE', <<'OUT', 'open and close - asynchronous' );
172 $P1 = # TT #1204 create a callback here
173 $P0 = new ['FileHandle']
176 say 'ok 1 - $P0.open($S1)'
179 say 'ok 2 - $P0.close($P1)'
181 $P0.'open'('README', 'rw')
182 say 'ok 3 - $P0.open($S1, $S2)'
186 say 'ok 4 - $P0.open()'
194 ok 3 - $P0.open($S1, $S2)
199 # L<PDD22/I\/O PMC API/=item read>
201 <<'CODE', <<'OUT', 'read - synchronous' );
203 $P0 = new ['FileHandle']
206 $S0 = $P0.'read'(14) # bytes
207 if $S0 == 'This is Parrot' goto ok_1
210 say 'ok 1 - $S0 = $P1.read($I2)'
212 $S0 = $P0.'read'(9) # bytes
213 if $S0 == ', version' goto ok_2
216 say 'ok 2 - $S0 = $P1.read($I2) # again on same stream'
219 ok 1 - $S0 = $P1.read($I2)
220 ok 2 - $S0 = $P1.read($I2) # again on same stream
223 # L<PDD22/I\/O PMC API/=item print>
224 pir_output_is( <<"CODE", <<'OUT', 'print - synchronous' );
227 \$P0 = new ['FileHandle']
228 \$P0.'open'('$temp_file', 'w')
231 say 'ok 1 - \$P0.print(\$I1)'
232 \$P0.'print'(456.789)
233 say 'ok 2 - \$P0.print(\$N1)'
234 \$P0.'print'("squawk\\n")
235 say 'ok 3 - \$P0.print(\$S1)'
236 \$P1 = new ['Integer']
239 say 'ok 4 - \$P0.print(\$P1)'
243 \$P1 = new ['FileHandle']
244 \$P1.'open'('$temp_file', 'r')
246 \$S0 = \$P1.'read'(3) # bytes
247 if \$S0 == "123" goto ok_5
250 say 'ok 5 - read integer back from file'
252 \$S0 = \$P1.'read'(16) # bytes
253 if \$S0 == "456.789squawk\\n42" goto ok_6
258 say 'ok 6 - read string back from file'
263 ok 1 - $P0.print($I1)
264 ok 2 - $P0.print($N1)
265 ok 3 - $P0.print($S1)
266 ok 4 - $P0.print($P1)
267 ok 5 - read integer back from file
268 ok 6 - read string back from file
271 (undef, $temp_file) = create_tempfile( UNLINK => 1 );
273 # L<PDD22/I\/O PMC API/=item print.*=item readline>
274 pir_output_is( <<"CODE", <<'OUT', 'readline - synchronous' );
276 load_bytecode 'String/Utils.pbc'
278 chomp = get_global ['String';'Utils'], 'chomp'
280 \$P0 = new ['FileHandle']
281 \$P0.'open'('$temp_file', 'w')
282 \$P0.'print'("foobarbaz\\n42")
285 \$P1 = new ['FileHandle']
286 \$P1.'open'('$temp_file')
288 \$S0 = \$P1.'readline'()
290 if \$S0 == 'foobarbaz' goto ok_1
293 say 'ok 1 - \$S0 = \$P1.readline()'
295 \$S0 = \$P1.'readline'()
297 if \$S0 == '42' goto ok_2
300 say 'ok 2 - \$S0 = \$P1.readline() # again on same stream'
305 ok 1 - $S0 = $P1.readline()
306 ok 2 - $S0 = $P1.readline() # again on same stream
310 ($LINES, $temp_file) = create_tempfile( UNLINK => 1 );
312 for my $counter (1 .. 10000) {
313 print $LINES $counter, "\n";
317 pir_output_is( <<"CODE", <<'OUT', 'readline 10,000 lines' );
319 load_bytecode 'String/Utils.pbc'
321 chomp = get_global ['String';'Utils'], 'chomp'
322 .local string test_line
323 .local pmc filehandle
325 filehandle = new ['FileHandle']
326 filehandle.'open'('$temp_file')
331 # read in the file one line at a time...
332 \$I0 = filehandle.'eof'()
333 if \$I0 goto end_read_loop
335 test_line = filehandle.'readline'()
336 if test_line == "" goto end_read_loop
337 test_line = chomp( test_line )
339 if \$I1 == counter goto read_loop
341 ## the following lines provide more extensive debugging
342 ## output on a readline failure
351 if counter > 1 goto read_something
354 say 'ok 1 - read 10,000 lines'
358 ok 1 - read 10,000 lines
362 # TT #1204 test reading long chunks, eof, and across newlines
364 # TT #1204 pir_output_is( <<'CODE', <<'OUT', 'print, read, and readline - asynchronous', todo => 'not yet implemented' );
366 # L<PDD22/I\/O PMC API/=item record_separator>
367 pir_output_is( <<'CODE', <<'OUT', 'record_separator', todo => 'not yet implemented' );
369 $P0 = new ['FileHandle']
371 $S0 = $P0.'record_separator'()
372 if $S0 == "\n" goto ok_1
375 say 'ok 1 - $S0 = $P1.record_separator() # default'
378 $P0.'record_separator'($S99)
379 $S0 = $P0.'record_separator'()
380 if $S0 == $S99 goto ok_2
383 say 'ok 2 - $P0.record_separator($S1)'
386 $S0 = $P0.'record_separator'()
390 $S0 = $P0.'readline'()
391 if $S0 == '123abc' goto ok_3
394 say 'ok 3 - $P0.record_separator() # .readline works as expected'
397 ok 1 - $S0 = $P1.record_separator() # default
398 ok 2 - $P0.record_separator($S1)
399 ok 3 - $P0.record_separator() # .readline works as expected
402 # L<PDD22/I\/O PMC API/=item buffer_type>
403 pir_output_is( <<'CODE', <<'OUT', 'buffer_type' );
405 $P0 = new ['FileHandle']
407 $P0.'buffer_type'('unbuffered')
408 $S0 = $P0.'buffer_type'()
409 if $S0 == 'unbuffered' goto ok_1
412 say 'ok 1 - $S0 = $P1.buffer_type() # unbuffered'
414 $P0.'buffer_type'('line-buffered')
415 $S0 = $P0.'buffer_type'()
416 if $S0 == 'line-buffered' goto ok_2
419 say 'ok 2 - $S0 = $P1.buffer_type() # line-buffered'
421 $P0.'buffer_type'('full-buffered')
422 $S0 = $P0.'buffer_type'()
423 if $S0 == 'full-buffered' goto ok_3
426 say 'ok 3 - $S0 = $P1.buffer_type() # full-buffered'
430 ok 1 - $S0 = $P1.buffer_type() # unbuffered
431 ok 2 - $S0 = $P1.buffer_type() # line-buffered
432 ok 3 - $S0 = $P1.buffer_type() # full-buffered
435 # TT #1204 test effects of buffer_type, not just set/get
438 # L<PDD22/I\/O PMC API/=item buffer_size>
439 # NOTES: try setting positive, zero, negative int
440 # perform print and read ops
441 # change buffer size while it contains data
442 # try with all 'buffer_type' modes
444 (undef, $temp_file) = create_tempfile( UNLINK => 1 );
446 pir_output_is( <<"CODE", <<'OUT', 'buffer_size' );
448 \$P0 = new ['FileHandle']
450 \$P0.'buffer_type'('full-buffered')
451 \$P0.'buffer_size'(42)
452 say 'ok 1 - \$P0.buffer_size(42) # set buffer size'
454 \$I0 = \$P0.'buffer_size'()
456 # The set buffer size is a minimum, the I/O subsystem may scale it upward
457 # to a round block, so test that the buffer size is equal or greater than
459 if \$I0 >= 42 goto ok_2
462 say 'ok 2 - \$I0 = \$P0.buffer_size() # get buffer size'
464 \$P0.'open'('$temp_file', 'w')
466 \$P0.'print'(1234567890)
469 \$P1 = new ['FileHandle']
470 \$P1.'open'('$temp_file')
472 \$S0 = \$P1.'readline'()
474 if \$S0 == '1234567890' goto ok_3
477 say 'ok 3 - \$S0 = \$P0.readline() # buffer flushed'
483 ok 1 - $P0.buffer_size(42) # set buffer size
484 ok 2 - $I0 = $P0.buffer_size() # get buffer size
485 ok 3 - $S0 = $P0.readline() # buffer flushed
488 # L<PDD22/I\/O PMC API/=item encoding>
489 pir_output_is( <<'CODE', <<'OUT', 'encoding' );
491 $P0 = new ['FileHandle']
493 $P0.'encoding'('utf8')
494 $S0 = $P0.'encoding'()
495 if $S0 == 'utf8' goto ok_1
498 say 'ok 1 - $S0 = $P1.encoding() # utf8'
502 ok 1 - $S0 = $P1.encoding() # utf8
505 (undef, $temp_file) = create_tempfile( UNLINK => 1 );
507 pir_output_is( <<"CODE", <<'OUT', 'encoding - read/write' );
509 \$P0 = new ['FileHandle']
510 \$P0.'encoding'('utf8')
512 \$P0.'open'('$temp_file', 'w')
514 \$P0.'print'(1234567890)
516 \$S0 = iso-8859-1:"TÖTSCH"
520 \$P1 = new ['FileHandle']
521 \$P1.'encoding'('utf8')
523 \$P1.'open'('$temp_file')
526 line = \$P1.'readline'()
527 if line == "1234567890\\n" goto ok_1
531 say 'ok 1 - \$S1 = \$P1.readline() # read with utf8 encoding on'
533 line = \$P1.'readline'()
534 if line == \$S0 goto ok_2
538 say 'ok 2 - \$S2 = \$P1.readline() # read iso-8859-1 string'
543 \$S2 = encodingname \$I1
544 if \$S2 == 'utf8' goto ok_3
548 say 'ok 3 # utf8 encoding'
552 ok 1 - $S1 = $P1.readline() # read with utf8 encoding on
553 ok 2 - $S2 = $P1.readline() # read iso-8859-1 string
558 (undef, $temp_file) = create_tempfile( UNLINK => 1 );
560 # L<PDD22/I\/O PMC API/=item mode>
561 pir_output_is( <<'CODE', <<'OUT', 'mode' );
563 $P0 = new ['FileHandle']
568 if $S0 == 'r' goto ok_1
571 say 'ok 1 - $S0 = $P0.mode() # get read mode'
577 ok 1 - $S0 = $P0.mode() # get read mode
580 pir_output_is( <<"CODE", <<"OUTPUT", "readall - closed filehandle" );
588 pio = new ['FileHandle']
589 pio.'open'("$temp_file", "w")
592 pio2 = new ['FileHandle']
593 \$S1 = pio2.'readall'('$temp_file')
594 if \$S0 == \$S1 goto ok
603 pir_output_is( <<"CODE", <<"OUTPUT", "readall() - opened filehandle" );
611 pio = new ['FileHandle']
612 pio.'open'("$temp_file", "w")
616 pio2 = new ['FileHandle']
617 pio2.'open'("$temp_file", "r")
618 \$S1 = pio2.'readall'()
619 if \$S0 == \$S1 goto ok
628 pir_output_is( <<'CODE', <<'OUTPUT', "readall - failure conditions" );
629 .include 'except_types.pasm'
632 fh = new ['FileHandle']
633 eh = new ['ExceptionHandler']
634 eh.'handle_types'(.EXCEPTION_PIO_ERROR)
637 # Using unopened FileHandle
639 say 'should never happen'
643 say 'caught unopened'
647 # Using opened FileHandle with the filepath option
648 fh.'readall'('README')
649 say 'should never happen'
661 pir_output_is( <<"CODE", <<"OUTPUT", "readall() - utf8 on closed filehandle" );
664 ifh = new ['FileHandle']
665 ifh.'encoding'('utf8')
667 \$S0 = ifh.'readall'('$temp_file')
670 \$S1 = encodingname \$I0
678 pir_output_is( <<"CODE", <<"OUTPUT", "readall() - utf8 on opened filehandle" );
681 ifh = new ['FileHandle']
682 ifh.'encoding'('utf8')
683 ifh.'open'('$temp_file')
685 \$S0 = ifh.'readall'()
688 \$S1 = encodingname \$I0
696 pir_output_is( <<'CODE', <<"OUTPUT", "exit status" );
697 .include 'iglobals.pasm'
699 .local pmc pipe, conf, interp
703 conf = interp[.IGLOBALS_CONFIG_HASH]
705 cmd = conf['build_dir']
710 aux = conf['test_prog']
715 pipe = new ['FileHandle']
716 pipe.'open'(cmd, "rp")
719 print "expect 0 exit status: "
720 $I0 = pipe.'exit_status'()
723 cmd .= ' --this_is_not_a_valid_option'
724 pipe = new ['FileHandle']
725 pipe.'open'(cmd, "rp")
728 print "expect 1 exit status: "
729 $I0 = pipe.'exit_status'()
735 expect 0 exit status: 0
736 expect 1 exit status: 1
739 pir_output_is( sprintf(<<'CODE', $temp_file), <<'OUTPUT', "timely destruction" );
740 .const string temp_file = '%s'
742 interpinfo $I0, 2 # GC mark runs
743 $P0 = new ['FileHandle']
744 $P0.'open'(temp_file, 'w')
746 print $P0, "a line\n"
748 sweep 0 # a lazy GC has to close the PIO
749 $P0 = new ['FileHandle']
750 $P0.'open'(temp_file, 'r')
758 my (undef, $no_such_file) = create_tempfile( UNLINK => 1, OPEN => 0 );
760 pir_output_is( sprintf( <<'CODE', $no_such_file, $temp_file ), <<'OUTPUT', "get_bool" );
761 .const string no_such_file = '%s'
762 .const string temp_file = '%s'
765 push_eh read_non_existent_file
766 $P0 = new ['FileHandle']
767 $P0.'open'(no_such_file, 'r')
771 print "' exists? - not "
775 $P0 = new ['FileHandle']
776 $P0.'open'(temp_file, 'w')
777 $P0.'print'("a line\n")
778 $P0.'print'("a line\n")
781 $P0 = new ['FileHandle']
782 $P0.'open'(temp_file, 'r')
786 $S0 = $P0.'read'(1024)
787 $S0 = $P0.'read'(1024)
796 defined $I0, $P0 # closed file is still defined
800 unless $P0, ok6 # but false
804 read_non_existent_file:
818 # L<PDD22/I\/O PMC API/=item get_fd>
819 # NOTES: this is going to be platform dependent
823 # cperl-indent-level: 4
826 # vim: expandtab shiftwidth=4: