t/pmc/filehandle.t

   1 #!perl
   2 # Copyright (C) 2006-2008, Parrot Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7 use lib qw( . lib ../lib ../../lib );
   8
   9 use Test::More;
  10 use Parrot::Test tests => 17;
  11 use Parrot::Test::Util 'create_tempfile';
  12 use Parrot::Test::Util 'create_tempfile';
  13
  14 =head1 NAME
  15
  16 t/pmc/filehandle.t - test the FileHandle PMC
  17
  18 =head1 SYNOPSIS
  19
  20     % prove t/pmc/filehandle.t
  21
  22 =head1 DESCRIPTION
  23
  24 Tests the FileHandle PMC.
  25
  26 =cut
  27
  28 # L<PDD22/I\/O PMC API/=item new>
  29 pir_output_is( <<'CODE', <<'OUT', 'new' );
  30 .sub 'test' :main
  31     $P0 = new ['FileHandle']
  32     say "ok 1 - $P0 = new ['FileHandle']"
  33 .end
  34 CODE
  35 ok 1 - $P0 = new ['FileHandle']
  36 OUT
  37
  38 my (undef, $temp_file) = create_tempfile( UNLINK => 1 );
  39
  40 # L<PDD22/I\/O PMC API/=item open.*=item close>
  41 pir_output_is( <<"CODE", <<'OUT', 'open and close - synchronous' );
  42 .sub 'test' :main
  43     \$P1 = new ['FileHandle']
  44     \$P1.'open'('README')
  45     say 'ok 1 - \$P1.open(\$S1)'
  46
  47     \$P1.'close'()
  48     say 'ok 2 - \$P1.close()'
  49
  50     \$P3 = new ['FileHandle']
  51     \$P3.'open'('$temp_file', 'rw')
  52     say 'ok 3 - \$P3.open(\$S1, \$S2) # rw mode'
  53     \$P3.'close'()
  54
  55     \$P3.'open'()
  56     say 'ok 4 - \$P3.open()         # reopening'
  57     \$P3.'close'()
  58
  59   test_5:
  60     \$P5 = new ['FileHandle']
  61     push_eh eh_bad_file_1
  62     \$P5.'open'('bad.file')
  63     pop_eh
  64
  65   test_6:
  66     \$P6 = new ['FileHandle']
  67     push_eh eh_bad_file_2
  68     \$P6.'open'('bad.file', 'r')
  69     pop_eh
  70
  71   test_7:
  72     \$P7 = new ['FileHandle']
  73     \$P7.'open'('$temp_file', 'w')
  74     say 'ok 7 - \$P7.open(\$S1, \$S2) # new file, write mode succeeds'
  75
  76     goto end
  77
  78   eh_bad_file_1:
  79     say 'ok 5 - \$P5.open(\$S1)      # with bad file'
  80     goto test_6
  81
  82   eh_bad_file_2:
  83     say "ok 6 - \$P6.open(\$S1, \$S2) # with bad file"
  84     goto test_7
  85
  86   end:
  87 .end
  88 CODE
  89 ok 1 - $P1.open($S1)
  90 ok 2 - $P1.close()
  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
  96 OUT
  97
  98 # RT #46827 test open file, close file, delete file, reopen previously opened stream
  99
 100 SKIP: {
 101     skip 'no asynch calls yet' => 1;
 102
 103     pir_output_is( <<'CODE', <<'OUT', 'open and close - asynchronous' );
 104 .sub 'test' :main
 105     $P1 = # RT #46831 create a callback here
 106     $P0 = new ['FileHandle']
 107
 108     $P0.'open'('README')
 109     say 'ok 1 - $P0.open($S1)'
 110
 111     $P0.'close'()
 112     say 'ok 2 - $P0.close($P1)'
 113
 114     $P0.'open'('README', 'rw')
 115     say 'ok 3 - $P0.open($S1, $S2)'
 116
 117     $P0.'close'()
 118     $P0.'open'()
 119     say 'ok 4 - $P0.open()'
 120
 121   cleanup:
 122     $P0.'close'()
 123 .end
 124 CODE
 125 ok 1 - $P0.open($S1)
 126 ok 2 - $P0.close()
 127 ok 3 - $P0.open($S1, $S2)
 128 ok 4 - $P0.open()
 129 OUT
 130 }
 131
 132 # L<PDD22/I\/O PMC API/=item read>
 133 pir_output_is(
 134     <<'CODE', <<'OUT', 'read - synchronous' );
 135 .sub 'test' :main
 136     $P0 = new ['FileHandle']
 137     $P0.'open'('README')
 138
 139     $S0 = $P0.'read'(14) # bytes
 140     if $S0 == 'This is Parrot' goto ok_1
 141     print 'not '
 142   ok_1:
 143     say 'ok 1 - $S0 = $P1.read($I2)'
 144
 145     $S0 = $P0.'read'(9)  # bytes
 146     if $S0 == ', version' goto ok_2
 147     print 'not '
 148   ok_2:
 149     say 'ok 2 - $S0 = $P1.read($I2) # again on same stream'
 150 .end
 151 CODE
 152 ok 1 - $S0 = $P1.read($I2)
 153 ok 2 - $S0 = $P1.read($I2) # again on same stream
 154 OUT
 155
 156 # L<PDD22/I\/O PMC API/=item print>
 157 pir_output_is( <<"CODE", <<'OUT', 'print - synchronous' );
 158 .sub 'test' :main
 159
 160     \$P0 = new ['FileHandle']
 161     \$P0.'open'('$temp_file', 'w')
 162
 163     \$P0.'print'(123)
 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']
 170     \$P1 = 42
 171     \$P0.'print'(\$P1)
 172     say 'ok 4 - \$P0.print(\$P1)'
 173
 174     \$P0.'close'()
 175
 176     \$P1 = new ['FileHandle']
 177     \$P1.'open'('$temp_file', 'r')
 178
 179     \$S0 = \$P1.'read'(3) # bytes
 180     if \$S0 == "123" goto ok_5
 181     print 'not '
 182   ok_5:
 183     say 'ok 5 - read integer back from file'
 184
 185     \$S0 = \$P1.'read'(16) # bytes
 186     if \$S0 == "456.789squawk\\n42" goto ok_6
 187     say \$S0
 188
 189     print 'not '
 190   ok_6:
 191     say 'ok 6 - read string back from file'
 192
 193     \$P1.'close'()
 194 .end
 195 CODE
 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
 202 OUT
 203
 204 (undef, $temp_file) = create_tempfile( UNLINK => 1 );
 205
 206 # L<PDD22/I\/O PMC API/=item print.*=item readline>
 207 pir_output_is( <<"CODE", <<'OUT', 'readline - synchronous' );
 208 .sub 'test' :main
 209     load_bytecode 'String/Utils.pbc'
 210     .local pmc chomp
 211                chomp = get_global ['String';'Utils'], 'chomp'
 212
 213     \$P0 = new ['FileHandle']
 214     \$P0.'open'('$temp_file', 'w')
 215     \$P0.'print'("foobarbaz\\n42")
 216     \$P0.'close'()
 217
 218     \$P1 = new ['FileHandle']
 219     \$P1.'open'('$temp_file')
 220
 221     \$S0 = \$P1.'readline'()
 222     \$S0 = chomp( \$S0 )
 223     if \$S0 == 'foobarbaz' goto ok_1
 224     print 'not '
 225   ok_1:
 226     say 'ok 1 - \$S0 = \$P1.readline()'
 227
 228     \$S0 = \$P1.'readline'()
 229     \$S0 = chomp( \$S0 )
 230     if \$S0 == '42' goto ok_2
 231     print 'not '
 232   ok_2:
 233     say 'ok 2 - \$S0 = \$P1.readline() # again on same stream'
 234
 235     \$P1.'close'()
 236 .end
 237 CODE
 238 ok 1 - $S0 = $P1.readline()
 239 ok 2 - $S0 = $P1.readline() # again on same stream
 240 OUT
 241
 242 my $LINES;
 243 ($LINES, $temp_file) = create_tempfile( UNLINK => 1 );
 244
 245 for my $counter (1 .. 10000) {
 246     print $LINES $counter, "\n";
 247 }
 248 close $LINES;
 249
 250 pir_output_is( <<"CODE", <<'OUT', 'readline 10,000 lines' );
 251 .sub 'test' :main
 252     load_bytecode 'String/Utils.pbc'
 253     .local pmc chomp
 254                chomp = get_global ['String';'Utils'], 'chomp'
 255     .local string test_line
 256     .local pmc filehandle
 257     .local int counter
 258     filehandle = new ['FileHandle']
 259     filehandle.'open'('$temp_file')
 260
 261     counter = 0
 262   read_loop:
 263     inc counter
 264     # read in the file one line at a time...
 265     \$I0 = filehandle.'eof'()
 266     if \$I0 goto end_read_loop
 267
 268     test_line = readline filehandle
 269     if test_line == "" goto end_read_loop
 270     test_line = chomp( test_line )
 271     \$I1 = test_line
 272     if \$I1 == counter goto read_loop
 273       print "not "
 274 ## the following lines provide more extensive debugging
 275 ## output on a readline failure
 276 #      print counter
 277 #      print " = "
 278 #      print \$I1
 279 #      print "\\n"
 280 #      counter = \$I1
 281 #      goto read_loop
 282
 283   end_read_loop:
 284     if counter > 1 goto read_something
 285       print "not "
 286   read_something:
 287     say 'ok 1 - read 10,000 lines'
 288     filehandle.'close'()
 289 .end
 290 CODE
 291 ok 1 - read 10,000 lines
 292 OUT
 293
 294
 295 # RT #46833 test reading/writing code points once supported
 296
 297 # RT #46835 test reading long chunks, eof, and across newlines
 298
 299 # RT #46837 pir_output_is( <<'CODE', <<'OUT', 'print, read, and readline - asynchronous', todo => 'not yet implemented' );
 300
 301 # L<PDD22/I\/O PMC API/=item record_separator>
 302 pir_output_is( <<'CODE', <<'OUT', 'record_separator', todo => 'not yet implemented' );
 303 .sub 'test' :main
 304     $P0 = new ['FileHandle']
 305
 306     $S0 = $P0.'record_separator'()
 307     if $S0 == "\n" goto ok_1
 308     print 'not '
 309   ok_1:
 310     say 'ok 1 - $S0 = $P1.record_separator() # default'
 311
 312     $S99 = 'abc'
 313     $P0.'record_separator'($S99)
 314     $S0 = $P0.'record_separator'()
 315     if $S0 == $S99 goto ok_2
 316     print 'not '
 317   ok_2:
 318     say 'ok 2 - $P0.record_separator($S1)'
 319
 320     $P0.'print'(123)
 321     $S0 = $P0.'record_separator'()
 322     $P0.'print'($S0)
 323     $P0.'print'(456)
 324
 325     $S0 = $P0.'readline'()
 326     if $S0 == '123abc' goto ok_3
 327     print 'not '
 328   ok_3:
 329     say 'ok 3 - $P0.record_separator() # .readline works as expected'
 330 .end
 331 CODE
 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
 335 OUT
 336
 337 # L<PDD22/I\/O PMC API/=item buffer_type>
 338 pir_output_is( <<'CODE', <<'OUT', 'buffer_type' );
 339 .sub 'test' :main
 340     $P0 = new ['FileHandle']
 341
 342     $P0.'buffer_type'('unbuffered')
 343     $S0 = $P0.'buffer_type'()
 344     if $S0 == 'unbuffered' goto ok_1
 345     print 'not '
 346   ok_1:
 347     say 'ok 1 - $S0 = $P1.buffer_type() # unbuffered'
 348
 349     $P0.'buffer_type'('line-buffered')
 350     $S0 = $P0.'buffer_type'()
 351     if $S0 == 'line-buffered' goto ok_2
 352     print 'not '
 353   ok_2:
 354     say 'ok 2 - $S0 = $P1.buffer_type() # line-buffered'
 355
 356     $P0.'buffer_type'('full-buffered')
 357     $S0 = $P0.'buffer_type'()
 358     if $S0 == 'full-buffered' goto ok_3
 359     print 'not '
 360   ok_3:
 361     say 'ok 3 - $S0 = $P1.buffer_type() # full-buffered'
 362
 363 .end
 364 CODE
 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
 368 OUT
 369
 370 # RT #46839 test effects of buffer_type, not just set/get
 371
 372 # RT #46841
 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
 378
 379 (undef, $temp_file) = create_tempfile( UNLINK => 1 );
 380
 381 pir_output_is( <<"CODE", <<'OUT', 'buffer_size' );
 382 .sub 'test' :main
 383     \$P0 = new ['FileHandle']
 384
 385     \$P0.'buffer_type'('full-buffered')
 386     \$P0.'buffer_size'(42)
 387     say 'ok 1 - \$P0.buffer_size(42)     # set buffer size'
 388
 389     \$I0 = \$P0.'buffer_size'()
 390
 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
 393     # the set size.
 394     if \$I0 >= 42 goto ok_2
 395     print 'not '
 396   ok_2:
 397     say 'ok 2 - \$I0 = \$P0.buffer_size() # get buffer size'
 398
 399     \$P0.'open'('$temp_file', 'w')
 400
 401     \$P0.'print'(1234567890)
 402     \$P0.'close'()
 403
 404     \$P1 = new ['FileHandle']
 405     \$P1.'open'('$temp_file')
 406
 407     \$S0 = \$P1.'readline'()
 408
 409     if \$S0 == '1234567890' goto ok_3
 410     print 'not '
 411   ok_3:
 412     say 'ok 3 - \$S0 = \$P0.readline()    # buffer flushed'
 413
 414     \$P1.'close'()
 415
 416 .end
 417 CODE
 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
 421 OUT
 422
 423 # L<PDD22/I\/O PMC API/=item encoding>
 424 pir_output_is( <<'CODE', <<'OUT', 'encoding' );
 425 .sub 'test' :main
 426     $P0 = new ['FileHandle']
 427
 428     $P0.'encoding'('utf8')
 429     $S0 = $P0.'encoding'()
 430     if $S0 == 'utf8' goto ok_1
 431     print 'not '
 432   ok_1:
 433     say 'ok 1 - $S0 = $P1.encoding() # utf8'
 434
 435 .end
 436 CODE
 437 ok 1 - $S0 = $P1.encoding() # utf8
 438 OUT
 439
 440 (undef, $temp_file) = create_tempfile( UNLINK => 1 );
 441
 442 pir_output_is( <<"CODE", <<'OUT', 'encoding - read/write' );
 443 .sub 'test' :main
 444     \$P0 = new ['FileHandle']
 445     \$P0.'encoding'('utf8')
 446
 447     \$P0.'open'('$temp_file', 'w')
 448
 449     \$P0.'print'(1234567890)
 450     \$P0.'print'("\\n")
 451     \$S0 = iso-8859-1:"TÖTSCH"
 452     \$P0.'print'(\$S0)
 453     \$P0.'close'()
 454
 455     \$P1 = new ['FileHandle']
 456     \$P1.'encoding'('utf8')
 457
 458     \$P1.'open'('$temp_file')
 459
 460     \$S1 = \$P1.'readline'()
 461     if \$S1 == "1234567890\\n" goto ok_1
 462 print \$S1
 463     print 'not '
 464   ok_1:
 465     say 'ok 1 - \$S1 = \$P1.readline() # read with utf8 encoding on'
 466
 467     \$S2 = \$P1.'readline'()
 468     if \$S2 == \$S0 goto ok_2
 469 print \$S2
 470     print 'not '
 471   ok_2:
 472     say 'ok 2 - \$S2 = \$P1.readline() # read iso-8859-1 string'
 473
 474     \$P1.'close'()
 475
 476 .end
 477 CODE
 478 ok 1 - $S1 = $P1.readline() # read with utf8 encoding on
 479 ok 2 - $S2 = $P1.readline() # read iso-8859-1 string
 480 OUT
 481
 482
 483 (undef, $temp_file) = create_tempfile( UNLINK => 1 );
 484
 485 # L<PDD22/I\/O PMC API/=item mode>
 486 pir_output_is( <<'CODE', <<'OUT', 'mode' );
 487 .sub 'test' :main
 488     $P0 = new ['FileHandle']
 489
 490     $P0.'open'('README')
 491     $S0 = $P0.'mode'()
 492
 493     if $S0 == 'r' goto ok_1
 494     print 'not '
 495   ok_1:
 496     say 'ok 1 - $S0 = $P0.mode() # get read mode'
 497
 498     $P0.'close'()
 499
 500 .end
 501 CODE
 502 ok 1 - $S0 = $P0.mode() # get read mode
 503 OUT
 504
 505 pir_output_is( <<"CODE", <<"OUTPUT", "readall - closed filehandle" );
 506 .sub main :main
 507     \$S0 = <<"EOS"
 508 line 1
 509 line 2
 510 line 3
 511 EOS
 512     .local pmc pio, pio2
 513     pio = new ['FileHandle']
 514     pio.'open'("$temp_file", "w")
 515     pio.'print'(\$S0)
 516     pio.'close'()
 517     pio2 = new ['FileHandle']
 518     \$S1 = pio2.'readall'('$temp_file')
 519     if \$S0 == \$S1 goto ok
 520     print "not "
 521 ok:
 522     say "ok"
 523 .end
 524 CODE
 525 ok
 526 OUTPUT
 527
 528 pir_output_is( <<"CODE", <<"OUTPUT", "readall() - opened filehandle" );
 529 .sub main :main
 530     \$S0 = <<"EOS"
 531 line 1
 532 line 2
 533 line 3
 534 EOS
 535     .local pmc pio, pio2
 536     pio = new ['FileHandle']
 537     pio.'open'("$temp_file", "w")
 538     pio.'print'(\$S0)
 539     pio.'close'()
 540
 541     pio2 = new ['FileHandle']
 542     pio2.'open'("$temp_file", "r")
 543     \$S1 = pio2.'readall'()
 544     if \$S0 == \$S1 goto ok
 545     print "not "
 546 ok:
 547     say "ok"
 548 .end
 549 CODE
 550 ok
 551 OUTPUT
 552
 553 pir_output_is( <<"CODE", <<"OUTPUT", "readall() - utf8 on closed filehandle" );
 554 .sub 'main'
 555     .local pmc ifh
 556     ifh = new ['FileHandle']
 557     ifh.'encoding'('utf8')
 558
 559     \$S0 = ifh.'readall'('$temp_file')
 560
 561     \$I0 = encoding \$S0
 562     \$S1 = encodingname \$I0
 563
 564     say \$S1
 565 .end
 566 CODE
 567 utf8
 568 OUTPUT
 569
 570 pir_output_is( <<"CODE", <<"OUTPUT", "readall() - utf8 on opened filehandle" );
 571 .sub 'main'
 572     .local pmc ifh
 573     ifh = new ['FileHandle']
 574     ifh.'encoding'('utf8')
 575     ifh.'open'('$temp_file')
 576
 577     \$S0 = ifh.'readall'()
 578
 579     \$I0 = encoding \$S0
 580     \$S1 = encodingname \$I0
 581
 582     say \$S1
 583 .end
 584 CODE
 585 utf8
 586 OUTPUT
 587
 588 # RT #46843
 589 # L<PDD22/I\/O PMC API/=item get_fd>
 590 # NOTES: this is going to be platform dependent
 591
 592 # Local Variables:
 593 #   mode: cperl
 594 #   cperl-indent-level: 4
 595 #   fill-column: 100
 596 # End:
 597 # vim: expandtab shiftwidth=4: