t/pmc/stringhandle.t

   1 #!perl
   2 # Copyright (C) 2006-2010, 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 => 25;
  11
  12 =head1 NAME
  13
  14 t/pmc/stringhandle.t - test the StringHandle PMC
  15
  16 =head1 SYNOPSIS
  17
  18     % prove t/pmc/stringhandle.t
  19
  20 =head1 DESCRIPTION
  21
  22 Tests the StringHandle PMC.
  23
  24 =cut
  25
  26 # L<PDD22/I\/O PMC API/=item new>
  27 pir_output_is( <<'CODE', <<'OUT', 'new' );
  28 .sub 'test' :main
  29     new $P0, ['StringHandle']
  30     say "ok 1 - $P0 = new ['StringHandle']"
  31 .end
  32 CODE
  33 ok 1 - $P0 = new ['StringHandle']
  34 OUT
  35
  36 # L<PDD22/I\/O PMC API/=item open.*=item close>
  37 pir_output_is( <<"CODE", <<'OUT', 'open and close - synchronous' );
  38 .sub 'test' :main
  39     \$P1 = new ['StringHandle']
  40     \$P1.'open'('README')
  41     say 'ok 1 - \$P1.open(\$S1)'
  42
  43     \$P1.'close'()
  44     say 'ok 2 - \$P1.close()'
  45
  46     \$P3 = new ['StringHandle']
  47     \$P3.'open'('temp_file', 'rw')
  48     say 'ok 3 - \$P3.open(\$S1, \$S2) # rw mode'
  49     \$P3.'close'()
  50
  51     \$P3.'open'()
  52     say 'ok 4 - \$P3.open()         # reopening'
  53     \$P3.'close'()
  54
  55   test_7:
  56     \$P7 = new ['StringHandle']
  57     \$P7.'open'('temp_file', 'w')
  58     say 'ok 7 - \$P7.open(\$S1, \$S2) # new file, write mode succeeds'
  59
  60     goto end
  61
  62   end:
  63 .end
  64 CODE
  65 ok 1 - $P1.open($S1)
  66 ok 2 - $P1.close()
  67 ok 3 - $P3.open($S1, $S2) # rw mode
  68 ok 4 - $P3.open()         # reopening
  69 ok 7 - $P7.open($S1, $S2) # new file, write mode succeeds
  70 OUT
  71
  72 pir_output_is( <<'CODE', <<'OUT', 'get_bool' );
  73 .sub test :main
  74     .local pmc sh
  75     .local int b
  76     sh = new ['StringHandle']
  77     b = 0
  78     unless sh goto b_false
  79     b = 1
  80   b_false:
  81     say b
  82     sh.'open'('mockname', 'w')
  83     sh.'print'('Some content')
  84     sh.'close'()
  85     sh.'open'()
  86     b = 0
  87     unless sh goto b_true
  88     b = 1
  89   b_true:
  90     say b
  91 .end
  92 CODE
  93 0
  94 1
  95 OUT
  96
  97 # StringHandle doesn't use file descriptor, get_fd always return -1
  98 pir_output_is( <<'CODE', <<'OUT', 'get_fd method' );
  99 .sub test :main
 100     .local pmc sh
 101     .local int fd
 102     sh = new ['StringHandle']
 103     fd = sh.'get_fd'()
 104     say fd
 105     sh.'open'('mockname', 'r')
 106     fd = sh.'get_fd'()
 107     say fd
 108 .end
 109 CODE
 110 -1
 111 -1
 112 OUT
 113
 114 SKIP: {
 115     skip 'no asynch calls yet' => 1;
 116
 117     pir_output_is( <<'CODE', <<'OUT', 'open and close - asynchronous' );
 118 .sub 'test' :main
 119     $P1 = # TT #1204 create a callback here
 120     $P0 = new ['StringHandle']
 121
 122     $P0.'open'('README')
 123     say 'ok 1 - $P0.open($S1)'
 124
 125     $P0.'close'()
 126     say 'ok 2 - $P0.close($P1)'
 127
 128     $P0.'open'('README', 'rw')
 129     say 'ok 3 - $P0.open($S1, $S2)'
 130
 131     $P0.'close'()
 132     $P0.'open'()
 133     say 'ok 4 - $P0.open()'
 134
 135   cleanup:
 136     $P0.'close'()
 137 .end
 138 CODE
 139 ok 1 - $P0.open($S1)
 140 ok 2 - $P0.close()
 141 ok 3 - $P0.open($S1, $S2)
 142 ok 4 - $P0.open()
 143 OUT
 144 }
 145
 146 # L<PDD22/I\/O PMC API/=item read>
 147 pir_output_is(
 148     <<'CODE', <<'OUT', 'read - synchronous' );
 149 .sub 'test' :main
 150     $P0 = new ['StringHandle']
 151     $P0.'open'('README', 'w')
 152
 153     $P0.'print'("This is Parrot, version")
 154
 155     $P0.'close'()
 156
 157     $P0.'open'('README')
 158
 159     $S0 = $P0.'read'(14) # bytes
 160     if $S0 == 'This is Parrot' goto ok_1
 161     print 'not '
 162   ok_1:
 163     say 'ok 1 - $S0 = $P1.read($I2)'
 164
 165     $S0 = $P0.'read'(9)  # bytes
 166     if $S0 == ', version' goto ok_2
 167     print 'not '
 168   ok_2:
 169     say 'ok 2 - $S0 = $P1.read($I2) # again on same stream'
 170 .end
 171 CODE
 172 ok 1 - $S0 = $P1.read($I2)
 173 ok 2 - $S0 = $P1.read($I2) # again on same stream
 174 OUT
 175
 176 pir_output_is(
 177     <<'CODE', <<'OUT', 'read opcode' );
 178 .sub 'test' :main
 179     $P0 = new ['StringHandle']
 180     $P0.'open'('README', 'w')
 181
 182     print $P0, "This is Parrot, version"
 183     $P0.'close'()
 184
 185     $P0.'open'('README')
 186
 187     $S0 = $P0.'read'(14) # bytes
 188     if $S0 == 'This is Parrot' goto ok_1
 189     print 'not '
 190   ok_1:
 191     say 'ok 1 - $S0 = $P1.read($I2)'
 192
 193     $S0 = $P0.'read'(9)  # bytes
 194     if $S0 == ', version' goto ok_2
 195     print 'not '
 196   ok_2:
 197     say 'ok 2 - $S0 = $P1.read($I2) # again on same stream'
 198 .end
 199 CODE
 200 ok 1 - $S0 = $P1.read($I2)
 201 ok 2 - $S0 = $P1.read($I2) # again on same stream
 202 OUT
 203
 204 # L<PDD22/I\/O PMC API/=item print>
 205 pir_output_is( <<"CODE", <<'OUT', 'print - synchronous' );
 206 .sub 'test' :main
 207
 208     \$P0 = new ['StringHandle']
 209     \$P0.'open'('temp_file', 'w')
 210
 211     \$P0.'print'(123)
 212     say 'ok 1 - \$P0.print(\$I1)'
 213     \$P0.'print'(456.789)
 214     say 'ok 2 - \$P0.print(\$N1)'
 215     \$P0.'print'("squawk\\n")
 216     say 'ok 3 - \$P0.print(\$S1)'
 217     \$P1 = new ['Integer']
 218     \$P1 = 42
 219     \$P0.'print'(\$P1)
 220     say 'ok 4 - \$P0.print(\$P1)'
 221
 222     \$P0.'close'()
 223
 224     \$P0.'open'('temp_file', 'r')
 225
 226     \$S0 = \$P0.'read'(3) # bytes
 227     if \$S0 == "123" goto ok_5
 228     print 'not '
 229   ok_5:
 230     say 'ok 5 - read integer back from file'
 231
 232     \$S0 = \$P0.'read'(16) # bytes
 233     if \$S0 == "456.789squawk\\n42" goto ok_6
 234     say \$S0
 235
 236     print 'not '
 237   ok_6:
 238     say 'ok 6 - read string back from file'
 239
 240     \$P0.'close'()
 241 .end
 242 CODE
 243 ok 1 - $P0.print($I1)
 244 ok 2 - $P0.print($N1)
 245 ok 3 - $P0.print($S1)
 246 ok 4 - $P0.print($P1)
 247 ok 5 - read integer back from file
 248 ok 6 - read string back from file
 249 OUT
 250
 251 pir_output_is( <<'CODE', <<'OUT', 'puts' );
 252 .include 'except_types.pasm'
 253 .sub 'test' :main
 254     .local pmc sh, eh
 255     .local int result
 256     sh = new ['StringHandle']
 257     eh = new ['ExceptionHandler']
 258     eh.'handle_types'(.EXCEPTION_PIO_ERROR)
 259     push_eh eh
 260
 261     # puts to SH not opened
 262     result = 0
 263     set_addr eh, handle1
 264     sh.'puts'('something')
 265     result = 1
 266     goto done1
 267 handle1:
 268     finalize eh
 269 done1:
 270     say result
 271
 272     # puts to SH opened for reading
 273     result = 0
 274     set_addr eh, handle2
 275     sh.'open'('mockname', 'r')
 276     sh.'puts'('something')
 277     result = 1
 278     goto done2
 279 handle2:
 280     finalize eh
 281 done2:
 282     say result
 283 .end
 284 CODE
 285 0
 286 0
 287 OUT
 288
 289 # L<PDD22/I\/O PMC API/=item print.*=item readline>
 290 pir_output_is( <<"CODE", <<'OUT', 'readline - synchronous' );
 291 .sub 'test' :main
 292     load_bytecode 'String/Utils.pbc'
 293     .local pmc chomp
 294                chomp = get_global ['String';'Utils'], 'chomp'
 295
 296     \$P0 = new ['StringHandle']
 297     \$P0.'open'('temp_file', 'w')
 298     \$P0.'print'("foobarbaz\\n42")
 299     \$P0.'close'()
 300
 301     \$P0.'open'('temp_file')
 302
 303     \$S0 = \$P0.'readline'()
 304     \$S0 = chomp( \$S0 )
 305     if \$S0 == 'foobarbaz' goto ok_1
 306     print 'not '
 307   ok_1:
 308     say 'ok 1 - \$S0 = \$P0.readline()'
 309
 310     \$S0 = \$P0.'readline'()
 311     \$S0 = chomp( \$S0 )
 312     if \$S0 == '42' goto ok_2
 313     print 'not '
 314   ok_2:
 315     say 'ok 2 - \$S0 = \$P0.readline() # again on same stream'
 316
 317     \$P0.'close'()
 318 .end
 319 CODE
 320 ok 1 - $S0 = $P0.readline()
 321 ok 2 - $S0 = $P0.readline() # again on same stream
 322 OUT
 323
 324 pir_output_is( <<'CODE', <<'OUT', 'readline 10,000 lines' );
 325 .sub 'test' :main
 326     load_bytecode 'String/Utils.pbc'
 327     .local pmc chomp
 328                chomp = get_global ['String';'Utils'], 'chomp'
 329     .local string test_line
 330     .local pmc stringhandle
 331     .local int counter
 332     stringhandle = new ['StringHandle']
 333
 334     stringhandle.'open'('temp_file', 'w')
 335
 336     counter = 0
 337   write_loop:
 338     inc counter
 339     if counter > 10000 goto end_write_loop
 340
 341     stringhandle.'print'(counter)
 342     stringhandle.'print'("\n")
 343
 344     goto write_loop
 345   end_write_loop:
 346     stringhandle.'close'()
 347     stringhandle.'open'('temp_file')
 348
 349     counter = 0
 350   read_loop:
 351     inc counter
 352     # read in the file one line at a time...
 353     $I0 = stringhandle.'eof'()
 354     if $I0 goto end_read_loop
 355
 356     test_line = stringhandle.'readline'()
 357     if test_line == "" goto end_read_loop
 358     test_line = chomp( test_line )
 359     $I1 = test_line
 360     if $I1 == counter goto read_loop
 361       print "not "
 362 ## the following lines provide more extensive debugging
 363 ## output on a readline failure
 364 #      print counter
 365 #      print " = "
 366 #      print $I1
 367 #      print "\n"
 368 #      counter = $I1
 369 #      goto read_loop
 370
 371   end_read_loop:
 372     if counter > 9000 goto read_something
 373       print "not "
 374   read_something:
 375     say 'ok 1 - read 10,000 lines'
 376     stringhandle.'close'()
 377 .end
 378 CODE
 379 ok 1 - read 10,000 lines
 380 OUT
 381
 382
 383 # TT #1204 test reading long chunks, eof, and across newlines
 384
 385 # TT #1204 pir_output_is( <<'CODE', <<'OUT', 'print, read, and readline - asynchronous', todo => 'not yet implemented' );
 386
 387 # L<PDD22/I\/O PMC API/=item record_separator>
 388 pir_output_is( <<'CODE', <<'OUT', 'record_separator', todo => 'not yet implemented' );
 389 .sub 'test' :main
 390     $P0 = new ['StringHandle']
 391
 392     $S0 = $P0.'record_separator'()
 393     if $S0 == "\n" goto ok_1
 394     print 'not '
 395   ok_1:
 396     say 'ok 1 - $S0 = $P1.record_separator() # default'
 397
 398     $S99 = 'abc'
 399     $P0.'record_separator'($S99)
 400     $S0 = $P0.'record_separator'()
 401     if $S0 == $S99 goto ok_2
 402     print 'not '
 403   ok_2:
 404     say 'ok 2 - $P0.record_separator($S1)'
 405
 406     $P0.'print'(123)
 407     $S0 = $P0.'record_separator'()
 408     $P0.'print'($S0)
 409     $P0.'print'(456)
 410
 411     $S0 = $P0.'readline'()
 412     if $S0 == '123abc' goto ok_3
 413     print 'not '
 414   ok_3:
 415     say 'ok 3 - $P0.record_separator() # .readline works as expected'
 416 .end
 417 CODE
 418 ok 1 - $S0 = $P1.record_separator() # default
 419 ok 2 - $P0.record_separator($S1)
 420 ok 3 - $P0.record_separator() # .readline works as expected
 421 OUT
 422
 423 # L<PDD22/I\/O PMC API/=item buffer_type>
 424 pir_output_is( <<'CODE', <<'OUT', 'buffer_type' );
 425 .sub 'test' :main
 426     $P0 = new ['StringHandle']
 427
 428     $P0.'buffer_type'('unbuffered')
 429     $S0 = $P0.'buffer_type'()
 430     if $S0 == 'unbuffered' goto ok_1
 431     print 'not '
 432   ok_1:
 433     say 'ok 1 - $S0 = $P1.buffer_type() # unbuffered'
 434
 435     $P0.'buffer_type'('line-buffered')
 436     $S0 = $P0.'buffer_type'()
 437     if $S0 == 'line-buffered' goto ok_2
 438     print 'not '
 439   ok_2:
 440     say 'ok 2 - $S0 = $P1.buffer_type() # line-buffered'
 441
 442     $P0.'buffer_type'('full-buffered')
 443     $S0 = $P0.'buffer_type'()
 444     if $S0 == 'full-buffered' goto ok_3
 445     print 'not '
 446   ok_3:
 447     say 'ok 3 - $S0 = $P1.buffer_type() # full-buffered'
 448
 449 .end
 450 CODE
 451 ok 1 - $S0 = $P1.buffer_type() # unbuffered
 452 ok 2 - $S0 = $P1.buffer_type() # line-buffered
 453 ok 3 - $S0 = $P1.buffer_type() # full-buffered
 454 OUT
 455
 456 # TT #1204 test effects of buffer_type, not just set/get
 457
 458 # TT #1177
 459 # L<PDD22/I\/O PMC API/=item buffer_size>
 460 # NOTES: try setting positive, zero, negative int
 461 # perform print and read ops
 462 # change buffer size while it contains data
 463 # try with all 'buffer_type' modes
 464
 465 pir_output_is( <<"CODE", <<'OUT', 'buffer_size' );
 466 .sub 'test' :main
 467     \$P0 = new ['StringHandle']
 468
 469     \$P0.'buffer_type'('full-buffered')
 470     \$P0.'buffer_size'(42)
 471     say 'ok 1 - \$P0.buffer_size(42)     # set buffer size'
 472
 473     \$P0.'open'('temp_file', 'w')
 474     \$P0.'print'(1234567890)
 475
 476     \$I0 = \$P0.'buffer_size'()
 477
 478     # The set buffer size is a minimum, the I/O subsystem may scale it upward
 479     # to a round block, so test that the buffer size is equal or greater than
 480     # the set size.
 481     if \$I0 == 10 goto ok_2
 482     print 'not '
 483   ok_2:
 484     say 'ok 2 - \$I0 = \$P0.buffer_size() # get buffer size'
 485
 486     \$P0.'close'()
 487
 488     \$P0.'open'('temp_file')
 489     \$S0 = \$P0.'readline'()
 490
 491     if \$S0 == '1234567890' goto ok_3
 492     print 'not '
 493   ok_3:
 494     say 'ok 3 - \$S0 = \$P0.readline()    # buffer flushed'
 495
 496     \$P0.'close'()
 497
 498 .end
 499 CODE
 500 ok 1 - $P0.buffer_size(42)     # set buffer size
 501 ok 2 - $I0 = $P0.buffer_size() # get buffer size
 502 ok 3 - $S0 = $P0.readline()    # buffer flushed
 503 OUT
 504
 505 # L<PDD22/I\/O PMC API/=item encoding>
 506 pir_output_is( <<'CODE', <<'OUT', 'encoding' );
 507 .sub 'test' :main
 508     $P0 = new ['StringHandle']
 509
 510     $P0.'encoding'('utf8')
 511     $S0 = $P0.'encoding'()
 512     if $S0 == 'utf8' goto ok_1
 513     print 'not '
 514   ok_1:
 515     say 'ok 1 - $S0 = $P1.encoding() # utf8'
 516
 517 .end
 518 CODE
 519 ok 1 - $S0 = $P1.encoding() # utf8
 520 OUT
 521
 522 pir_output_is( <<"CODE", <<'OUT', 'encoding - read/write' );
 523 .sub 'test' :main
 524     \$P0 = new ['StringHandle']
 525     \$P0.'encoding'('utf8')
 526
 527     \$P0.'open'('temp_file', 'w')
 528
 529     \$P0.'print'(1234567890)
 530     \$P0.'print'("\\n")
 531     \$S0 = iso-8859-1:"TÖTSCH"
 532     \$P0.'print'(\$S0)
 533     \$P0.'close'()
 534
 535     \$P0.'open'('temp_file')
 536
 537     \$S1 = \$P0.'readline'()
 538     if \$S1 == "1234567890\\n" goto ok_1
 539 print \$S1
 540     print 'not '
 541   ok_1:
 542     say 'ok 1 - \$S1 = \$P0.readline() # read with utf8 encoding on'
 543
 544     \$S2 = \$P0.'readline'()
 545     if \$S2 == \$S0 goto ok_2
 546 print \$S2
 547     print 'not '
 548   ok_2:
 549     say 'ok 2 - \$S2 = \$P0.readline() # read iso-8859-1 string'
 550
 551     \$P0.'close'()
 552
 553 .end
 554 CODE
 555 ok 1 - $S1 = $P0.readline() # read with utf8 encoding on
 556 ok 2 - $S2 = $P0.readline() # read iso-8859-1 string
 557 OUT
 558
 559
 560 # L<PDD22/I\/O PMC API/=item mode>
 561 pir_output_is( <<'CODE', <<'OUT', 'mode' );
 562 .sub 'test' :main
 563     $P0 = new ['StringHandle']
 564
 565     $P0.'open'('README')
 566     $S0 = $P0.'mode'()
 567
 568     if $S0 == 'r' goto ok_1
 569     print 'not '
 570   ok_1:
 571     say 'ok 1 - $S0 = $P0.mode() # get read mode'
 572
 573     $P0.'close'()
 574
 575 .end
 576 CODE
 577 ok 1 - $S0 = $P0.mode() # get read mode
 578 OUT
 579
 580 pir_output_is( <<"CODE", <<"OUTPUT", "readall - closed stringhandle" );
 581 .sub main :main
 582     \$S0 = <<"EOS"
 583 line 1
 584 line 2
 585 line 3
 586 EOS
 587     .local pmc pio, pio2
 588     pio = new ['StringHandle']
 589     pio.'open'("temp_file", "w")
 590     pio.'print'(\$S0)
 591     pio.'close'()
 592     pio.'open'("temp_file")
 593     \$S1 = pio.'readall'('temp_file')
 594     if \$S0 == \$S1 goto ok
 595     print "not "
 596 ok:
 597     say "ok"
 598 .end
 599 CODE
 600 ok
 601 OUTPUT
 602
 603 pir_output_is( <<"CODE", <<"OUTPUT", "readall - stringhandle with null content" );
 604 .sub main :main
 605     .local pmc sh
 606     .local string s
 607     sh = new ['StringHandle']
 608     sh.'open'('mockname', 'r')
 609     # Open sets content to an empty string, flush resets is to null
 610     # and that is the case we are testing here.
 611     # Also, ensures coverage of the flush method.
 612     sh.'flush'()
 613     s = sh.'readall'()
 614     print '['
 615     print s
 616     say ']'
 617 .end
 618 CODE
 619 []
 620 OUTPUT
 621
 622 pir_output_is( <<"CODE", <<"OUTPUT", "readall() - opened stringhandle" );
 623 .sub main :main
 624     \$S0 = <<"EOS"
 625 line 1
 626 line 2
 627 line 3
 628 EOS
 629     .local pmc pio, pio2
 630     pio = new ['StringHandle']
 631     pio.'open'("temp_file", "w")
 632     pio.'print'(\$S0)
 633     pio.'close'()
 634
 635     pio.'open'("temp_file", "r")
 636     \$S1 = pio.'readall'()
 637     if \$S0 == \$S1 goto ok
 638     print "not "
 639 ok:
 640     say "ok"
 641 .end
 642 CODE
 643 ok
 644 OUTPUT
 645
 646 pir_output_is( <<'CODE', <<"OUTPUT", "is_closed" );
 647 .sub main
 648     .local pmc sh
 649     .local int i
 650     sh = new ['StringHandle']
 651     i = sh.'is_closed'()
 652     say i
 653     sh.'open'("foo", "w")
 654     i = sh.'is_closed'()
 655     say i
 656 .end
 657 CODE
 658 1
 659 0
 660 OUTPUT
 661
 662 pir_output_is( <<'CODE', <<'OUTPUT', 'StringHandle is not a tty' );
 663 .sub main
 664     .local pmc sh
 665     .local int i
 666     sh = new ['StringHandle']
 667
 668     i = sh.'isatty'()
 669     say i
 670 .end
 671 CODE
 672 0
 673 OUTPUT
 674
 675 pir_output_is( <<"CODE", <<"OUTPUT", "readall() - utf8 on closed stringhandle" );
 676 .sub 'main'
 677     .local pmc ifh
 678     ifh = new ['StringHandle']
 679     ifh.'encoding'('utf8')
 680
 681     \$S0 = ifh.'readall'('temp_file')
 682
 683     \$I0 = encoding \$S0
 684     \$S1 = encodingname \$I0
 685
 686     say \$S1
 687 .end
 688 CODE
 689 utf8
 690 OUTPUT
 691
 692 pir_output_is( <<"CODE", <<"OUTPUT", "readall() - utf8 on opened stringhandle" );
 693 .sub 'main'
 694     .local pmc ifh
 695     ifh = new ['StringHandle']
 696     ifh.'encoding'('utf8')
 697     ifh.'open'('temp_file')
 698
 699     \$S0 = ifh.'readall'()
 700
 701     \$I0 = encoding \$S0
 702     \$S1 = encodingname \$I0
 703
 704     say \$S1
 705 .end
 706 CODE
 707 utf8
 708 OUTPUT
 709
 710 pir_output_is( <<'CODE', <<'OUTPUT', "clone an uninitialized stringhandle" );
 711 .sub 'main'
 712     $P0 = new ['StringHandle']
 713     $P1 = clone $P0
 714     say "ok"
 715 .end
 716 CODE
 717 ok
 718 OUTPUT
 719
 720 # TT #1178
 721 # L<PDD22/I\/O PMC API/=item get_fd>
 722 # NOTES: this is going to be platform dependent
 723
 724 # Local Variables:
 725 #   mode: cperl
 726 #   cperl-indent-level: 4
 727 #   fill-column: 100
 728 # End:
 729 # vim: expandtab shiftwidth=4: