t/pmc/stringhandle.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 => 19;
  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 SKIP: {
  73     skip 'no asynch calls yet' => 1;
  74
  75     pir_output_is( <<'CODE', <<'OUT', 'open and close - asynchronous' );
  76 .sub 'test' :main
  77     $P1 = # TT #1204 create a callback here
  78     $P0 = new ['StringHandle']
  79
  80     $P0.'open'('README')
  81     say 'ok 1 - $P0.open($S1)'
  82
  83     $P0.'close'()
  84     say 'ok 2 - $P0.close($P1)'
  85
  86     $P0.'open'('README', 'rw')
  87     say 'ok 3 - $P0.open($S1, $S2)'
  88
  89     $P0.'close'()
  90     $P0.'open'()
  91     say 'ok 4 - $P0.open()'
  92
  93   cleanup:
  94     $P0.'close'()
  95 .end
  96 CODE
  97 ok 1 - $P0.open($S1)
  98 ok 2 - $P0.close()
  99 ok 3 - $P0.open($S1, $S2)
 100 ok 4 - $P0.open()
 101 OUT
 102 }
 103
 104 # L<PDD22/I\/O PMC API/=item read>
 105 pir_output_is(
 106     <<'CODE', <<'OUT', 'read - synchronous' );
 107 .sub 'test' :main
 108     $P0 = new ['StringHandle']
 109     $P0.'open'('README', 'w')
 110
 111     $P0.'print'("This is Parrot, version")
 112
 113     $P0.'close'()
 114
 115     $P0.'open'('README')
 116
 117     $S0 = $P0.'read'(14) # bytes
 118     if $S0 == 'This is Parrot' goto ok_1
 119     print 'not '
 120   ok_1:
 121     say 'ok 1 - $S0 = $P1.read($I2)'
 122
 123     $S0 = $P0.'read'(9)  # bytes
 124     if $S0 == ', version' goto ok_2
 125     print 'not '
 126   ok_2:
 127     say 'ok 2 - $S0 = $P1.read($I2) # again on same stream'
 128 .end
 129 CODE
 130 ok 1 - $S0 = $P1.read($I2)
 131 ok 2 - $S0 = $P1.read($I2) # again on same stream
 132 OUT
 133
 134 pir_output_is(
 135     <<'CODE', <<'OUT', 'read opcode' );
 136 .sub 'test' :main
 137     $P0 = new ['StringHandle']
 138     $P0.'open'('README', 'w')
 139
 140     print $P0, "This is Parrot, version"
 141     close $P0
 142
 143     $P0.'open'('README')
 144
 145     $S0 = read $P0, 14 # bytes
 146     if $S0 == 'This is Parrot' goto ok_1
 147     print 'not '
 148   ok_1:
 149     say 'ok 1 - $S0 = read $P1, $I2'
 150
 151     $S0 = read $P0, 9  # bytes
 152     if $S0 == ', version' goto ok_2
 153     print 'not '
 154   ok_2:
 155     say 'ok 2 - $S0 = read $P1, $I2 # again on same stream'
 156 .end
 157 CODE
 158 ok 1 - $S0 = read $P1, $I2
 159 ok 2 - $S0 = read $P1, $I2 # again on same stream
 160 OUT
 161
 162 # L<PDD22/I\/O PMC API/=item print>
 163 pir_output_is( <<"CODE", <<'OUT', 'print - synchronous' );
 164 .sub 'test' :main
 165
 166     \$P0 = new ['StringHandle']
 167     \$P0.'open'('temp_file', 'w')
 168
 169     \$P0.'print'(123)
 170     say 'ok 1 - \$P0.print(\$I1)'
 171     \$P0.'print'(456.789)
 172     say 'ok 2 - \$P0.print(\$N1)'
 173     \$P0.'print'("squawk\\n")
 174     say 'ok 3 - \$P0.print(\$S1)'
 175     \$P1 = new ['Integer']
 176     \$P1 = 42
 177     \$P0.'print'(\$P1)
 178     say 'ok 4 - \$P0.print(\$P1)'
 179
 180     \$P0.'close'()
 181
 182     \$P0.'open'('temp_file', 'r')
 183
 184     \$S0 = \$P0.'read'(3) # bytes
 185     if \$S0 == "123" goto ok_5
 186     print 'not '
 187   ok_5:
 188     say 'ok 5 - read integer back from file'
 189
 190     \$S0 = \$P0.'read'(16) # bytes
 191     if \$S0 == "456.789squawk\\n42" goto ok_6
 192     say \$S0
 193
 194     print 'not '
 195   ok_6:
 196     say 'ok 6 - read string back from file'
 197
 198     \$P0.'close'()
 199 .end
 200 CODE
 201 ok 1 - $P0.print($I1)
 202 ok 2 - $P0.print($N1)
 203 ok 3 - $P0.print($S1)
 204 ok 4 - $P0.print($P1)
 205 ok 5 - read integer back from file
 206 ok 6 - read string back from file
 207 OUT
 208
 209 # L<PDD22/I\/O PMC API/=item print.*=item readline>
 210 pir_output_is( <<"CODE", <<'OUT', 'readline - synchronous' );
 211 .sub 'test' :main
 212     load_bytecode 'String/Utils.pbc'
 213     .local pmc chomp
 214                chomp = get_global ['String';'Utils'], 'chomp'
 215
 216     \$P0 = new ['StringHandle']
 217     \$P0.'open'('temp_file', 'w')
 218     \$P0.'print'("foobarbaz\\n42")
 219     \$P0.'close'()
 220
 221     \$P0.'open'('temp_file')
 222
 223     \$S0 = \$P0.'readline'()
 224     \$S0 = chomp( \$S0 )
 225     if \$S0 == 'foobarbaz' goto ok_1
 226     print 'not '
 227   ok_1:
 228     say 'ok 1 - \$S0 = \$P0.readline()'
 229
 230     \$S0 = \$P0.'readline'()
 231     \$S0 = chomp( \$S0 )
 232     if \$S0 == '42' goto ok_2
 233     print 'not '
 234   ok_2:
 235     say 'ok 2 - \$S0 = \$P0.readline() # again on same stream'
 236
 237     \$P0.'close'()
 238 .end
 239 CODE
 240 ok 1 - $S0 = $P0.readline()
 241 ok 2 - $S0 = $P0.readline() # again on same stream
 242 OUT
 243
 244 pir_output_is( <<'CODE', <<'OUT', 'readline 10,000 lines' );
 245 .sub 'test' :main
 246     load_bytecode 'String/Utils.pbc'
 247     .local pmc chomp
 248                chomp = get_global ['String';'Utils'], 'chomp'
 249     .local string test_line
 250     .local pmc stringhandle
 251     .local int counter
 252     stringhandle = new ['StringHandle']
 253
 254     stringhandle.'open'('temp_file', 'w')
 255
 256     counter = 0
 257   write_loop:
 258     inc counter
 259     if counter > 10000 goto end_write_loop
 260
 261     stringhandle.'print'(counter)
 262     stringhandle.'print'("\n")
 263
 264     goto write_loop
 265   end_write_loop:
 266     stringhandle.'close'()
 267     stringhandle.'open'('temp_file')
 268
 269     counter = 0
 270   read_loop:
 271     inc counter
 272     # read in the file one line at a time...
 273     $I0 = stringhandle.'eof'()
 274     if $I0 goto end_read_loop
 275
 276     test_line = readline stringhandle
 277     if test_line == "" goto end_read_loop
 278     test_line = chomp( test_line )
 279     $I1 = test_line
 280     if $I1 == counter goto read_loop
 281       print "not "
 282 ## the following lines provide more extensive debugging
 283 ## output on a readline failure
 284 #      print counter
 285 #      print " = "
 286 #      print $I1
 287 #      print "\n"
 288 #      counter = $I1
 289 #      goto read_loop
 290
 291   end_read_loop:
 292     if counter > 9000 goto read_something
 293       print "not "
 294   read_something:
 295     say 'ok 1 - read 10,000 lines'
 296     stringhandle.'close'()
 297 .end
 298 CODE
 299 ok 1 - read 10,000 lines
 300 OUT
 301
 302
 303 # TT #1204 test reading long chunks, eof, and across newlines
 304
 305 # TT #1204 pir_output_is( <<'CODE', <<'OUT', 'print, read, and readline - asynchronous', todo => 'not yet implemented' );
 306
 307 # L<PDD22/I\/O PMC API/=item record_separator>
 308 pir_output_is( <<'CODE', <<'OUT', 'record_separator', todo => 'not yet implemented' );
 309 .sub 'test' :main
 310     $P0 = new ['StringHandle']
 311
 312     $S0 = $P0.'record_separator'()
 313     if $S0 == "\n" goto ok_1
 314     print 'not '
 315   ok_1:
 316     say 'ok 1 - $S0 = $P1.record_separator() # default'
 317
 318     $S99 = 'abc'
 319     $P0.'record_separator'($S99)
 320     $S0 = $P0.'record_separator'()
 321     if $S0 == $S99 goto ok_2
 322     print 'not '
 323   ok_2:
 324     say 'ok 2 - $P0.record_separator($S1)'
 325
 326     $P0.'print'(123)
 327     $S0 = $P0.'record_separator'()
 328     $P0.'print'($S0)
 329     $P0.'print'(456)
 330
 331     $S0 = $P0.'readline'()
 332     if $S0 == '123abc' goto ok_3
 333     print 'not '
 334   ok_3:
 335     say 'ok 3 - $P0.record_separator() # .readline works as expected'
 336 .end
 337 CODE
 338 ok 1 - $S0 = $P1.record_separator() # default
 339 ok 2 - $P0.record_separator($S1)
 340 ok 3 - $P0.record_separator() # .readline works as expected
 341 OUT
 342
 343 # L<PDD22/I\/O PMC API/=item buffer_type>
 344 pir_output_is( <<'CODE', <<'OUT', 'buffer_type' );
 345 .sub 'test' :main
 346     $P0 = new ['StringHandle']
 347
 348     $P0.'buffer_type'('unbuffered')
 349     $S0 = $P0.'buffer_type'()
 350     if $S0 == 'unbuffered' goto ok_1
 351     print 'not '
 352   ok_1:
 353     say 'ok 1 - $S0 = $P1.buffer_type() # unbuffered'
 354
 355     $P0.'buffer_type'('line-buffered')
 356     $S0 = $P0.'buffer_type'()
 357     if $S0 == 'line-buffered' goto ok_2
 358     print 'not '
 359   ok_2:
 360     say 'ok 2 - $S0 = $P1.buffer_type() # line-buffered'
 361
 362     $P0.'buffer_type'('full-buffered')
 363     $S0 = $P0.'buffer_type'()
 364     if $S0 == 'full-buffered' goto ok_3
 365     print 'not '
 366   ok_3:
 367     say 'ok 3 - $S0 = $P1.buffer_type() # full-buffered'
 368
 369 .end
 370 CODE
 371 ok 1 - $S0 = $P1.buffer_type() # unbuffered
 372 ok 2 - $S0 = $P1.buffer_type() # line-buffered
 373 ok 3 - $S0 = $P1.buffer_type() # full-buffered
 374 OUT
 375
 376 # TT #1204 test effects of buffer_type, not just set/get
 377
 378 # TT #1177
 379 # L<PDD22/I\/O PMC API/=item buffer_size>
 380 # NOTES: try setting positive, zero, negative int
 381 # perform print and read ops
 382 # change buffer size while it contains data
 383 # try with all 'buffer_type' modes
 384
 385 pir_output_is( <<"CODE", <<'OUT', 'buffer_size' );
 386 .sub 'test' :main
 387     \$P0 = new ['StringHandle']
 388
 389     \$P0.'buffer_type'('full-buffered')
 390     \$P0.'buffer_size'(42)
 391     say 'ok 1 - \$P0.buffer_size(42)     # set buffer size'
 392
 393     \$P0.'open'('temp_file', 'w')
 394     \$P0.'print'(1234567890)
 395
 396     \$I0 = \$P0.'buffer_size'()
 397
 398     # The set buffer size is a minimum, the I/O subsystem may scale it upward
 399     # to a round block, so test that the buffer size is equal or greater than
 400     # the set size.
 401     if \$I0 == 10 goto ok_2
 402     print 'not '
 403   ok_2:
 404     say 'ok 2 - \$I0 = \$P0.buffer_size() # get buffer size'
 405
 406     \$P0.'close'()
 407
 408     \$P0.'open'('temp_file')
 409     \$S0 = \$P0.'readline'()
 410
 411     if \$S0 == '1234567890' goto ok_3
 412     print 'not '
 413   ok_3:
 414     say 'ok 3 - \$S0 = \$P0.readline()    # buffer flushed'
 415
 416     \$P0.'close'()
 417
 418 .end
 419 CODE
 420 ok 1 - $P0.buffer_size(42)     # set buffer size
 421 ok 2 - $I0 = $P0.buffer_size() # get buffer size
 422 ok 3 - $S0 = $P0.readline()    # buffer flushed
 423 OUT
 424
 425 # L<PDD22/I\/O PMC API/=item encoding>
 426 pir_output_is( <<'CODE', <<'OUT', 'encoding' );
 427 .sub 'test' :main
 428     $P0 = new ['StringHandle']
 429
 430     $P0.'encoding'('utf8')
 431     $S0 = $P0.'encoding'()
 432     if $S0 == 'utf8' goto ok_1
 433     print 'not '
 434   ok_1:
 435     say 'ok 1 - $S0 = $P1.encoding() # utf8'
 436
 437 .end
 438 CODE
 439 ok 1 - $S0 = $P1.encoding() # utf8
 440 OUT
 441
 442 pir_output_is( <<"CODE", <<'OUT', 'encoding - read/write' );
 443 .sub 'test' :main
 444     \$P0 = new ['StringHandle']
 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     \$P0.'open'('temp_file')
 456
 457     \$S1 = \$P0.'readline'()
 458     if \$S1 == "1234567890\\n" goto ok_1
 459 print \$S1
 460     print 'not '
 461   ok_1:
 462     say 'ok 1 - \$S1 = \$P0.readline() # read with utf8 encoding on'
 463
 464     \$S2 = \$P0.'readline'()
 465     if \$S2 == \$S0 goto ok_2
 466 print \$S2
 467     print 'not '
 468   ok_2:
 469     say 'ok 2 - \$S2 = \$P0.readline() # read iso-8859-1 string'
 470
 471     \$P0.'close'()
 472
 473 .end
 474 CODE
 475 ok 1 - $S1 = $P0.readline() # read with utf8 encoding on
 476 ok 2 - $S2 = $P0.readline() # read iso-8859-1 string
 477 OUT
 478
 479
 480 # L<PDD22/I\/O PMC API/=item mode>
 481 pir_output_is( <<'CODE', <<'OUT', 'mode' );
 482 .sub 'test' :main
 483     $P0 = new ['StringHandle']
 484
 485     $P0.'open'('README')
 486     $S0 = $P0.'mode'()
 487
 488     if $S0 == 'r' goto ok_1
 489     print 'not '
 490   ok_1:
 491     say 'ok 1 - $S0 = $P0.mode() # get read mode'
 492
 493     $P0.'close'()
 494
 495 .end
 496 CODE
 497 ok 1 - $S0 = $P0.mode() # get read mode
 498 OUT
 499
 500 pir_output_is( <<"CODE", <<"OUTPUT", "readall - closed stringhandle" );
 501 .sub main :main
 502     \$S0 = <<"EOS"
 503 line 1
 504 line 2
 505 line 3
 506 EOS
 507     .local pmc pio, pio2
 508     pio = new ['StringHandle']
 509     pio.'open'("temp_file", "w")
 510     pio.'print'(\$S0)
 511     pio.'close'()
 512     pio.'open'("temp_file")
 513     \$S1 = pio.'readall'('temp_file')
 514     if \$S0 == \$S1 goto ok
 515     print "not "
 516 ok:
 517     say "ok"
 518 .end
 519 CODE
 520 ok
 521 OUTPUT
 522
 523 pir_output_is( <<"CODE", <<"OUTPUT", "readall() - opened stringhandle" );
 524 .sub main :main
 525     \$S0 = <<"EOS"
 526 line 1
 527 line 2
 528 line 3
 529 EOS
 530     .local pmc pio, pio2
 531     pio = new ['StringHandle']
 532     pio.'open'("temp_file", "w")
 533     pio.'print'(\$S0)
 534     pio.'close'()
 535
 536     pio.'open'("temp_file", "r")
 537     \$S1 = pio.'readall'()
 538     if \$S0 == \$S1 goto ok
 539     print "not "
 540 ok:
 541     say "ok"
 542 .end
 543 CODE
 544 ok
 545 OUTPUT
 546
 547 pir_output_is( <<"CODE", <<"OUTPUT", "readall() - utf8 on closed stringhandle" );
 548 .sub 'main'
 549     .local pmc ifh
 550     ifh = new ['StringHandle']
 551     ifh.'encoding'('utf8')
 552
 553     \$S0 = ifh.'readall'('temp_file')
 554
 555     \$I0 = encoding \$S0
 556     \$S1 = encodingname \$I0
 557
 558     say \$S1
 559 .end
 560 CODE
 561 utf8
 562 OUTPUT
 563
 564 pir_output_is( <<"CODE", <<"OUTPUT", "readall() - utf8 on opened stringhandle" );
 565 .sub 'main'
 566     .local pmc ifh
 567     ifh = new ['StringHandle']
 568     ifh.'encoding'('utf8')
 569     ifh.'open'('temp_file')
 570
 571     \$S0 = ifh.'readall'()
 572
 573     \$I0 = encoding \$S0
 574     \$S1 = encodingname \$I0
 575
 576     say \$S1
 577 .end
 578 CODE
 579 utf8
 580 OUTPUT
 581
 582 pir_output_is( <<'CODE', <<'OUTPUT', "clone an uninitialized stringhandle" );
 583 .sub 'main'
 584     $P0 = new ['StringHandle']
 585     $P1 = clone $P0
 586     say "ok"
 587 .end
 588 CODE
 589 ok
 590 OUTPUT
 591
 592 # TT #1178
 593 # L<PDD22/I\/O PMC API/=item get_fd>
 594 # NOTES: this is going to be platform dependent
 595
 596 # Local Variables:
 597 #   mode: cperl
 598 #   cperl-indent-level: 4
 599 #   fill-column: 100
 600 # End:
 601 # vim: expandtab shiftwidth=4: