t/pmc/io.t

   1 #! perl
   2 # Copyright (C) 2001-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 => 32;
  11 use Parrot::Test::Util 'create_tempfile';
  12
  13 =head1 NAME
  14
  15 t/pmc/io.t - IO Ops
  16
  17 =head1 SYNOPSIS
  18
  19     % prove t/pmc/io.t
  20
  21 =head1 DESCRIPTION
  22
  23 Tests the Parrot IO operations.
  24
  25 =cut
  26
  27 sub file_content_is {
  28     my ( $file, $content, $name ) = @_;
  29
  30     # slurp mode
  31     local $/;
  32
  33     open my $FOO, '<', $file;
  34
  35     local $Test::Builder::Level = $Test::Builder::Level + 1;
  36     is( <$FOO>, $content, $name );
  37
  38     close $FOO;
  39 }
  40
  41 my (undef, $temp_file) = create_tempfile( UNLINK => 1 );
  42
  43 pir_output_is( sprintf(<<'CODE', $temp_file), <<'OUTPUT', "timely destruction" );
  44 .const string temp_file = '%s'
  45 .sub main :main
  46     interpinfo $I0, 2    # GC mark runs
  47     $P0 = new ['FileHandle']
  48     $P0.'open'(temp_file, 'w')
  49     needs_destroy $P0
  50     print $P0, "a line\n"
  51     null $P0            # kill it
  52     sweep 0            # a lazy GC has to close the PIO
  53     $P0 = new ['FileHandle']
  54     $P0.'open'(temp_file, 'r')
  55     $S0 = $P0.'read'(20)
  56     print $S0
  57 .end
  58 CODE
  59 a line
  60 OUTPUT
  61
  62 pir_output_is( <<'CODE', <<'OUTPUT', "read on invalid fh should throw exception" );
  63 .sub main :main
  64     new $P0, ['FileHandle']
  65
  66     push_eh _readline_handler
  67     $S0 = $P0.'readline'()
  68     print "not "
  69
  70 _readline_handler:
  71         print "ok 1\n"
  72         pop_eh
  73
  74     push_eh _read_handler
  75     $S0 = $P0.'read'(1)
  76     print "not "
  77
  78 _read_handler:
  79         print "ok 2\n"
  80         pop_eh
  81
  82     push_eh _print_handler
  83     print $P0, "kill me now\n"
  84     print "not "
  85
  86 _print_handler:
  87         print "ok 3\n"
  88         pop_eh
  89
  90 .end
  91 CODE
  92 ok 1
  93 ok 2
  94 ok 3
  95 OUTPUT
  96
  97 SKIP: {
  98     skip( "clone not finished yet", 1 );
  99     pasm_output_is( <<"CODE", <<'OUTPUT', "clone" );
 100     open P0, "$temp_file", 'r'
 101     clone P1, P0
 102     read S0, P1, 1024
 103     print S0
 104     end
 105 CODE
 106 a line
 107 OUTPUT
 108 }
 109
 110 (my $FOO, $temp_file) = create_tempfile( UNLINK => 1 );
 111
 112 # It would be very embarrassing if these didnt work...
 113 print $FOO "2\n1\n";
 114 close $FOO;
 115
 116 pir_output_is( sprintf( <<'CODE', $temp_file ), <<'OUTPUT', "open and readline" );
 117 .const string temp_file = '%s'
 118 .sub 'main' :main
 119     $P0 = new ['FileHandle']
 120     $P0.'open'(temp_file)
 121
 122     $S0 = ''
 123     $S1 = ''
 124
 125     $S0 = $P0.'readline'()
 126     $S1 = $P0.'readline'()
 127
 128     print $S1
 129     print $S0
 130 .end
 131 CODE
 132 1
 133 2
 134 OUTPUT
 135
 136 ($FOO, $temp_file) = create_tempfile( UNLINK => 1 );
 137 print $FOO "12\n34";
 138 close $FOO;
 139
 140 pir_output_is( sprintf( <<'CODE', $temp_file ), <<'OUTPUT', "open and readline, no final newline" );
 141 .const string temp_file = '%s'
 142 .sub 'main' :main
 143     $P0 = new ['FileHandle']
 144     $P0.'open'(temp_file)
 145
 146     $S0 = ''
 147     $S1 = ''
 148
 149     $S0 = $P0.'readline'()
 150     $S1 = $P0.'readline'()
 151
 152     print $S1
 153     print $S0
 154 .end
 155 CODE
 156 3412
 157 OUTPUT
 158
 159 ($FOO, $temp_file) = create_tempfile( UNLINK => 1 );
 160 close $FOO;
 161
 162 pir_output_is( sprintf(<<'CODE', $temp_file), <<'OUTPUT', "open & print" );
 163 .const string temp_file = '%s'
 164 .sub 'main' :main
 165     $I0 = -12
 166     $N0 = 2.2
 167     $S0 = "Foo"
 168     $P0 = new ['String']
 169     $P0 = "Bar\n"
 170
 171     $P1 = new ['FileHandle']
 172     $P1.'open'(temp_file, 'w')
 173     $P1.'print'($I0)
 174     $P1.'print'($N0)
 175     $P1.'print'($S0)
 176     $P1.'print'($P0)
 177     $P1.'close'()
 178
 179     $P2 = new ['FileHandle']
 180     $P2.'open'(temp_file)
 181     $S1 = $P2.'readline'()
 182     $P2.'close'()
 183
 184     print $S1
 185 .end
 186 CODE
 187 -122.2FooBar
 188 OUTPUT
 189
 190 ($FOO, $temp_file) = create_tempfile( UNLINK => 1 );
 191 close $FOO;
 192
 193 # write to file opened for reading
 194 pir_output_is( sprintf(<<'CODE', $temp_file), <<'OUTPUT', "3-arg open" );
 195 .const string temp_file = '%s'
 196 .sub 'main' :main
 197     $P1 = new ['FileHandle']
 198     $P1.'open'(temp_file, 'w')
 199     $P1.'print'("Foobar\n")
 200     $P1.'close'()
 201
 202     push_eh _print_to_read_only
 203
 204     $P2 = new ['FileHandle']
 205     $P2.'open'(temp_file, 'r')
 206     $P2.'print'("baz\n")
 207     say "skipped"
 208
 209   _print_to_read_only:
 210     say "caught writing to file opened for reading"
 211     pop_eh
 212
 213     $P2.'close'()
 214
 215     $P3 = new ['FileHandle']
 216     $P3.'open'(temp_file, 'r')
 217     $S1 = $P3.'readline'()
 218     $P3.'close'()
 219     print $S1
 220 .end
 221 CODE
 222 caught writing to file opened for reading
 223 Foobar
 224 OUTPUT
 225
 226 pir_output_is( sprintf(<<'CODE', $temp_file), <<'OUTPUT', 'open and close' );
 227 .const string temp_file = '%s'
 228 .sub 'main' :main
 229     $P1 = new ['FileHandle']
 230     $P1.'open'(temp_file, "w")
 231     $P1.'print'("Hello, World!\n")
 232     $P1.'close'()
 233     say "done"
 234 .end
 235 CODE
 236 done
 237 OUTPUT
 238
 239 file_content_is( $temp_file, <<'OUTPUT', 'file contents' );
 240 Hello, World!
 241 OUTPUT
 242
 243 pir_output_is( sprintf(<<'CODE', $temp_file), '', 'append' );
 244 .const string temp_file = '%s'
 245 .sub 'main' :main
 246     $P1 = new ['FileHandle']
 247     $P1.'open'(temp_file, 'wa')
 248     $P1.'print'("Parrot flies\n")
 249     $P1.'close'()
 250 .end
 251 CODE
 252
 253 file_content_is( $temp_file, <<'OUTPUT', 'append file contents' );
 254 Hello, World!
 255 Parrot flies
 256 OUTPUT
 257
 258 pir_output_is( sprintf(<<'CODE', $temp_file), '', 'write to file' );
 259 .const string temp_file = '%s'
 260 .sub 'main' :main
 261     $P1 = new ['FileHandle']
 262     $P1.'open'(temp_file, 'w')
 263     $P1.'print'("Parrot overwrites\n")
 264     $P1.'close'()
 265 .end
 266 CODE
 267
 268 file_content_is( $temp_file, <<'OUTPUT', 'file contents' );
 269 Parrot overwrites
 270 OUTPUT
 271
 272 pir_output_is( <<"CODE", '', "Parrot_io_flush on buffer full" );
 273 .sub "main"
 274    set \$I0, 0
 275    set \$I1, 10000
 276
 277    new \$P0, ['FileHandle']
 278    \$P0.'open'("$temp_file", 'w')
 279
 280 PRINT:
 281    ge \$I0, \$I1, END
 282    print \$P0, "words\\n"
 283    inc \$I0
 284    branch PRINT
 285
 286 END:
 287    \$P0.'close'()
 288 .end
 289 CODE
 290
 291 file_content_is( $temp_file, <<'OUTPUT' x 10000, 'buffered file contents' );
 292 words
 293 OUTPUT
 294
 295 pir_output_is( sprintf(<<'CODE', $temp_file), <<'OUTPUT', "turn off buffering" );
 296 .const string temp_file = '%s'
 297
 298 .sub main :main
 299     $P0 = new ['FileHandle']
 300     $P0.'open'(temp_file, 'w')
 301
 302 #   set buffer type
 303     $P0.'buffer_type'('unbuffered')
 304
 305 #   get buffer type
 306     $S0 = $P0.'buffer_type'()
 307     print $S0
 308     print "\n"
 309
 310     print $P0, "Howdy World\n"
 311
 312     $P0.'close'()
 313     end
 314 .end
 315 CODE
 316 unbuffered
 317 OUTPUT
 318
 319 file_content_is( $temp_file, <<'OUTPUT', 'unbuffered file contents' );
 320 Howdy World
 321 OUTPUT
 322
 323 pir_output_is( sprintf(<<'CODE', $temp_file), <<'OUTPUT', 'I/O buffering' );
 324 .const string temp_file = '%s'
 325
 326 .sub main
 327     .local string filename
 328     filename = temp_file
 329     $P1 = new ['FileHandle']
 330     $P1.'open'(filename, 'w')
 331     .local int count, max, nltest
 332     count = 0
 333     max = 10000
 334   LOOP:
 335     if count > max goto DONE
 336     $S1 = count
 337     $S1 = concat $S1, " "
 338     print $P1, $S1
 339     inc count
 340     nltest = mod count, 20
 341     if nltest goto LOOP
 342     print $P1, "\n"
 343     goto LOOP
 344   DONE:
 345     print $P1, "\n"
 346     $P1.'close'()
 347
 348   PART_2:
 349     $P1 = new ['FileHandle']
 350     $P1.'open'(filename)
 351     $I0 = 0
 352   LINE:
 353     $S1 = $P1.'readline'()
 354     unless $S1 goto SUCCESS
 355     $S1 = chopn $S1, 1
 356
 357   NEXT_NR:
 358     $I1 = length $S1
 359     if $I1 <= 1 goto LINE
 360     $S2 = ""
 361   SPLIT:
 362     $S3 = substr $S1, 0, 1
 363     $S1 = replace $S1, 0, 1, ""
 364     if $S3 == " " goto GOT_NR
 365     $S2 = concat $S2, $S3
 366     goto SPLIT
 367   GOT_NR:
 368     $I1 = $S2
 369     if $I0 != $I1 goto FAILED
 370     inc $I0
 371     goto NEXT_NR
 372
 373   FAILED:
 374     say "Failed"
 375     goto EXIT
 376   SUCCESS:
 377     say "Successful"
 378   EXIT:
 379     end
 380 .end
 381 CODE
 382 Successful
 383 OUTPUT
 384
 385 # TT #1178
 386 pir_output_is( <<'CODE', <<'OUT', 'standard file descriptors' );
 387 .include 'stdio.pasm'
 388 .sub main :main
 389     $P99 = getinterp
 390     $P0  = $P99.'stdhandle'(.PIO_STDIN_FILENO)
 391     $I0  = $P0.'get_fd'()
 392     # I0 is 0 on Unix and non-Null on stdio and win32
 393     print "ok 1\n"
 394
 395     $P1 = $P99.'stdhandle'(.PIO_STDOUT_FILENO)
 396     $I1 = $P1.'get_fd'()
 397     if $I1, OK_2
 398     print "not "
 399 OK_2:
 400     say "ok 2"
 401     $P2 = $P99.'stdhandle'(.PIO_STDERR_FILENO)
 402     $I2 = $P2.'get_fd'()
 403     if $I2, OK_3
 404     print "not "
 405 OK_3:
 406     say "ok 3"
 407 .end
 408 CODE
 409 ok 1
 410 ok 2
 411 ok 3
 412 OUT
 413
 414 pir_output_is( <<'CODE', <<'OUTPUT', 'puts method' );
 415 .include 'stdio.pasm'
 416 .sub main :main
 417     $P0 = getinterp
 418     $P2 = $P0.'stdhandle'(.PIO_STDOUT_FILENO)
 419     can $I0, $P2, "puts"
 420     if $I0, ok1
 421     print "not "
 422 ok1:   print "ok 1\n"
 423     set_args "0,0", $P2, "ok 2\n"
 424     callmethodcc $P2, "puts"
 425 .end
 426 CODE
 427 ok 1
 428 ok 2
 429 OUTPUT
 430
 431 pir_output_is( <<'CODE', <<'OUTPUT', 'puts method - PIR' );
 432 .include 'stdio.pasm'
 433 .sub main :main
 434    .local string s
 435    s = "ok 2\n"
 436    .local pmc io
 437    $P0 = getinterp
 438    io = $P0.'stdhandle'(.PIO_STDOUT_FILENO)
 439    $I0 = can io, "puts"
 440    if $I0 goto ok1
 441    print "not "
 442 ok1:   print "ok 1\n"
 443    io."puts"(s)
 444 .end
 445
 446 CODE
 447 ok 1
 448 ok 2
 449 OUTPUT
 450
 451 pasm_output_is( <<'CODE', <<'OUTPUT', 'callmethod puts' );
 452 .include 'stdio.pasm'
 453     getinterp P0                 # invocant
 454     set I0, .PIO_STDERR_FILENO   # 1st argument
 455     set_args "0,0", P0, I0
 456     callmethodcc P0, "stdhandle"
 457     get_results "0", P2          # STDERR
 458
 459     set S0, "puts"               # method
 460     set S5, "ok 1\n"             # 2nd param
 461     set_args "0,0", P2, S5
 462     callmethodcc P2, S0
 463
 464     set S5, "ok 2\n"
 465     set_args "0,0", P2, S5
 466     callmethodcc P2, S0
 467
 468     end
 469 CODE
 470 ok 1
 471 ok 2
 472 OUTPUT
 473
 474 pir_output_is( sprintf(<<'CODE', $temp_file), <<'OUTPUT', 'seek/tell' );
 475 .const string temp_file = '%s'
 476 .sub 'main' :main
 477     $P0 = new ['FileHandle']
 478
 479     $P0.'open'(temp_file, 'w')
 480     $P0.'print'("Hello ")
 481     $I0 = $P0.'tell'()
 482     $P0.'print'("World!")
 483     $P0.'seek'(0, $I0)
 484     $P0.'print'("Parrot!\n")
 485     $P0.'close'()
 486     say "ok 1"
 487
 488     $P0.'open'(temp_file, 'r')
 489     $S0 = $P0.'read'(65635)
 490     print $S0
 491 .end
 492 CODE
 493 ok 1
 494 Hello Parrot!
 495 OUTPUT
 496
 497 pir_error_output_like( sprintf(<<'CODE', $temp_file), <<'OUTPUT', '32bit seek: exception' );
 498 .const string temp_file = '%s'
 499 .sub main :main
 500     $P0 = new ['FileHandle']
 501     $P0.'open'(temp_file, 'w')
 502     $P0.'seek'(-1, 0)
 503     say "error!"
 504 .end
 505 CODE
 506 /seek failed/
 507 OUTPUT
 508
 509 pir_error_output_like( sprintf(<<'CODE', $temp_file), <<'OUTPUT', '64bit seek: exception' );
 510 .const string temp_file = '%s'
 511 .sub main :main
 512     $P0 = new ['FileHandle']
 513     $P0.'open'(temp_file, 'w')
 514     $P0.'seek'(-1, -1, 0)
 515     say "error!"
 516 .end
 517 CODE
 518 /seek failed/
 519 OUTPUT
 520
 521 pir_output_is( sprintf(<<'CODE', $temp_file), <<'OUTPUT', "peek" );
 522 .const string temp_file = '%s'
 523 .sub main :main
 524     $P0 = new ['FileHandle']
 525     $P0.'open'(temp_file, 'w')
 526     print $P0, "a line\n"
 527     $P0.'close'()
 528
 529     $P0 = new ['FileHandle']
 530     $P0.'open'(temp_file, 'r')
 531     $S0 = $P0.'peek'()
 532     print $S0
 533     $S1 = $P0.'peek'()
 534     print $S1
 535     print "\n"
 536     $S2 = $P0.'read'(2)
 537     $S3 = $P0.'peek'()
 538     print $S3
 539     print "\n"
 540 .end
 541 CODE
 542 aa
 543 l
 544 OUTPUT
 545
 546 pir_output_is( sprintf(<<'CODE', $temp_file), <<'OUTPUT', "peek on an empty file" );
 547 .const string temp_file = '%s'
 548 .sub main :main
 549     $P0 = new ['FileHandle']
 550     $P0.'open'(temp_file, 'w')
 551     $P0.'close'()
 552
 553     $P0 = new ['FileHandle']
 554     $P0.'open'(temp_file, 'r')
 555     $S0 = $P0.'peek'()
 556     eq $S0, "", OK1
 557     print "not "
 558 OK1:
 559     say "ok 1"
 560 .end
 561 CODE
 562 ok 1
 563 OUTPUT
 564
 565 pir_output_is( <<"CODE", <<'OUTPUT', "substr after reading from file" );
 566 .sub _main
 567     # Write something into a file
 568     .local pmc out
 569     out = new ['FileHandle']
 570     out.'open'("$temp_file", 'w')
 571     print out, "0123456789\\n"
 572     out.'close'()
 573
 574     # read file contents back in
 575     .local pmc in
 576     in = new ['FileHandle']
 577     in.'open'("$temp_file", 'r')
 578     .local string from_file
 579     from_file = in.'read'(20)
 580
 581     # Extract part of the read in file
 582     .local string head_from_file
 583     head_from_file = substr from_file, 0, 5
 584     say head_from_file
 585
 586     end
 587 .end
 588 CODE
 589 01234
 590 OUTPUT
 591
 592 pir_output_is( <<"CODE", <<'OUTPUT', "multiple substr after reading from file" );
 593
 594 .sub _main
 595     # Write something into a file
 596     .local pmc out
 597     out = new ['FileHandle']
 598     out.'open'("$temp_file", 'w')
 599     print out, "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ\\n"
 600     out.'close'()
 601
 602     .local pmc in
 603     .local string line
 604     in = new ['FileHandle']
 605     in.'open'('$temp_file', 'r')
 606     line = in.'read'(50000)
 607     in.'close'()
 608
 609     .local string sub_1
 610     sub_1 = ''
 611     .local string sub_2
 612     sub_2 = ''
 613     .local string sub_3
 614     sub_3 = ''
 615     substr sub_1, line, 0, 3
 616     substr sub_2, line, 3, 3
 617     line = replace line, 0, 6, ''
 618     print "line: "
 619     print line
 620     print "sub_1: "
 621     say sub_1
 622     print "sub_2: "
 623     say sub_2
 624   end
 625 .end
 626 CODE
 627 line: 6789ABCDEFGHIJKLMNOPQRSTUVWXYZ
 628 sub_1: 012
 629 sub_2: 345
 630 OUTPUT
 631
 632 ($FOO, $temp_file) = create_tempfile( UNLINK => 1 );
 633
 634 print $FOO "T\xc3\xb6tsch\n";
 635 close $FOO;
 636
 637 pir_output_is( sprintf(<<'CODE', $temp_file), <<"OUTPUT", "utf8 read enabled, read parts" );
 638 .const string temp_file = '%s'
 639 .sub main :main
 640     .local pmc pio
 641     pio = new ['FileHandle']
 642     pio.'open'(temp_file, 'r')
 643     pio.'encoding'("utf8")
 644     $S0 = pio.'read'(2)
 645     $S1 = pio.'read'(1024) # read the rest of the file (much shorter than 1K)
 646     $S0 .= $S1
 647     pio.'close'()
 648
 649     $I1 = encoding $S0
 650     $S2 = encodingname $I1
 651     say $S2
 652
 653     $I1 = find_encoding 'iso-8859-1'
 654     trans_encoding $S1, $S0, $I1
 655     print $S1
 656 .end
 657 CODE
 658 utf8
 659 T\xf6tsch
 660 OUTPUT
 661
 662 pir_output_is( <<"CODE", <<"OUTPUT", "PIO.readall() - classmeth" );
 663 .sub main :main
 664     \$S0 = <<"EOS"
 665 line 1
 666 line 2
 667 line 3
 668 EOS
 669     .local pmc pio, cl
 670     pio = new ['FileHandle']
 671     pio.'open'("$temp_file", 'w')
 672     print pio, \$S0
 673     pio.'close'()
 674     cl = new ['FileHandle']
 675     \$S1 = cl.'readall'('$temp_file')
 676     if \$S0 == \$S1 goto ok
 677     print "not "
 678 ok:
 679     say "ok"
 680 .end
 681 CODE
 682 ok
 683 OUTPUT
 684
 685 pir_output_is( <<"CODE", <<"OUTPUT", "PIO.readall() - object" );
 686 .sub main :main
 687     \$S0 = <<"EOS"
 688 line 1
 689 line 2
 690 line 3
 691 EOS
 692     .local pmc pio, pio2
 693     pio = new ['FileHandle']
 694     pio.'open'("$temp_file", 'w')
 695     print pio, \$S0
 696     pio.'close'()
 697
 698     pio2 = new ['FileHandle']
 699     pio2.'open'("$temp_file", 'r')
 700     \$S1 = pio2.'readall'()
 701     if \$S0 == \$S1 goto ok
 702     print "not "
 703 ok:
 704     say "ok"
 705 .end
 706 CODE
 707 ok
 708 OUTPUT
 709
 710 # Local Variables:
 711 #   mode: cperl
 712 #   cperl-indent-level: 4
 713 #   fill-column: 100
 714 # End:
 715 # vim: expandtab shiftwidth=4: