t/pmc/parrotio.t

   1 #!perl
   2 # Copyright (C) 2006-2007, The Perl Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7 use lib qw( . lib ../lib ../../lib );
   8 use Test::More;
   9 use Parrot::Test tests => 6;
  10
  11 =head1 NAME
  12
  13 t/pmc/parrotio.t - test the ParrotIO PMC
  14
  15 =head1 SYNOPSIS
  16
  17     % prove t/pmc/parrotio.t
  18
  19 =head1 DESCRIPTION
  20
  21 Tests the ParrotIO PMC.
  22
  23 =cut
  24
  25 # L<PDD22/I\/O PMC API/=item new>
  26 pir_output_is( <<'CODE', <<'OUT', 'new' );
  27 .sub 'test' :main
  28     new P0, 'ParrotIO'
  29     say "ok 1 - $P0 = new 'ParrotIO'"
  30 .end
  31 CODE
  32 ok 1 - $P0 = new 'ParrotIO'
  33 OUT
  34
  35 # L<PDD22/I\/O PMC API/=item open.*=item close>
  36 pir_output_is( <<'CODE', <<'OUT', 'open and close - synchronous', todo => 'not yet implemented' );
  37 .sub 'test' :main
  38     $P0 = new 'ParrotIO'
  39     $P0.open('README')
  40     say 'ok 1 - $P0.open($S1)'
  41
  42     $P0.close()
  43     say 'ok 2 - $P0.close()'
  44
  45     $P0.open('README', 'rw')
  46     say 'ok 3 - $P0.open($S1, $S2) # rw mode'
  47
  48     $P0.close()
  49     $P0.open()
  50     say 'ok 4 - $P0.open()'
  51
  52     push_eh eh_bad_file_1
  53     $P0.open('bad_file')
  54     pop_eh
  55
  56   test_5:
  57     push_eh eh_bad_file_2
  58     $P0.open('bad_file', 'r')
  59     pop_eh
  60
  61   test_6:
  62     $P0.open('new_file', 'w')
  63     say 'ok 6 - $P0.open($S1, $S2) # new file, write mode succeeds'
  64
  65     goto end
  66
  67   bad_file_1:
  68     say 'ok 5 - $P0.open($S1)      # with bad file'
  69     goto test_5
  70   end:
  71 .end
  72 CODE
  73 ok 1 - $P0.open($S1)
  74 ok 2 - $P0.close()
  75 ok 3 - $P0.open($S1, $S2) # rw mode
  76 ok 4 - $P0.open()
  77 ok 5 - $P0.open($S1)      # with bad file
  78 ok 6 - $P0.open($S1, $S2) # new file, write mode succeeds
  79 OUT
  80
  81 # RT#46827 test open file, close file, delete file, reopen previously opened stream
  82
  83 # RT#46829 cleanup 'new_file' in previous test; which is todo'd, so the
  84 # file isn't even being *generated* yet.
  85
  86 SKIP: {
  87     skip 'no asynch calls yet' => 1;
  88
  89     pir_output_is( <<'CODE', <<'OUT', 'open and close - asynchronous' );
  90 .sub 'test' :main
  91     $P1 = # RT#46831 create a callback here
  92     $P0 = new 'ParrotIO'
  93
  94     $P0.open('README')
  95     say 'ok 1 - $P0.open($S1)'
  96
  97     $P0.close()
  98     say 'ok 2 - $P0.close($P1)'
  99
 100     $P0.open('README', 'rw')
 101     say 'ok 3 - $P0.open($S1, $S2)'
 102
 103     $P0.close()
 104     $P0.open()
 105     say 'ok 4 - $P0.open()'
 106
 107   cleanup:
 108     $P0.close()
 109 .end
 110 CODE
 111 ok 1 - $P0.open($S1)
 112 ok 2 - $P0.close()
 113 ok 3 - $P0.open($S1, $S2)
 114 ok 4 - $P0.open()
 115 OUT
 116 }
 117
 118 # L<PDD22/I\/O PMC API/=item print.*=item readline>
 119 pir_output_is(
 120     <<'CODE', <<'OUT', 'print, read, and readline - synchronous', todo => 'not yet implemented' );
 121 .sub 'test' :main
 122     load_bytecode 'String/Utils.pbc'
 123     .local pmc chomp
 124                chomp = get_global ['String';'Utils'], 'chomp'
 125
 126     $P0 = new 'ParrotIO'
 127     $P0.open('README')
 128
 129     $S0 = $P0.read(14) # bytes
 130     if $S0 == 'This is Parrot' goto ok_1
 131     print 'not '
 132   ok_1:
 133     say 'ok 1 - $S0 = $P1.read($I2)'
 134
 135     $S0 = $P0.read(9)  # bytes
 136     if $S0 == ', version' goto ok_2
 137     print 'not '
 138   ok_2:
 139     say 'ok 2 - $S0 = $P1.read($I2)     # again on same stream'
 140
 141     $P0.print(123)
 142     $P0.print(456.789)
 143     $P0.print("squawk\n")
 144     $P1 = new 'Integer'
 145     $P1 = 42
 146     $P0.print($P1)
 147     say 'ok 3 - $P0.print(${I,N,S,P}1)'
 148
 149     $S0 = $P0.readline()
 150     $S0 = chomp( $S0 )
 151     if $S0 == '123456.789000squawk' goto ok_4
 152     print 'not '
 153   ok_4:
 154     say 'ok 4 - $S0 = $P1.readline($I2)'
 155
 156     $S0 = $P0.readline()
 157     $S0 = chomp( $S0 )
 158     if $S0 == '42' goto ok_5
 159     print 'not '
 160   ok_5:
 161     say 'ok 5 - $S0 = $P1.readline($I2) # again on same stream'
 162 .end
 163 CODE
 164 ok 1 - $S0 = $P1.read($I2)
 165 ok 2 - $S0 = $P1.read($I2)     # again on same stream
 166 ok 3 - $P0.print(${I,N,S,P}1)
 167 ok 4 - $S0 = $P1.readline($I2)
 168 ok 5 - $S0 = $P1.readline($I2) # again on same stream
 169 OUT
 170
 171 # RT#46833 test reading/writing code points once supported
 172
 173 # RT#46835 test reading long chunks, eof, and across newlines
 174
 175 # RT#46837 pir_output_is( <<'CODE', <<'OUT', 'print, read, and readline - asynchronous', todo => 'not yet implemented' );
 176
 177 # L<PDD22/I\/O PMC API/=item record_separator>
 178 pir_output_is( <<'CODE', <<'OUT', 'record_separator', todo => 'not yet implemented' );
 179 .sub 'test' :main
 180     $P0 = new 'ParrotIO'
 181
 182     $S0 = $P0.record_separator()
 183     if $S0 == "\n" goto ok_1
 184     print 'not '
 185   ok_1:
 186     say 'ok 1 - $S0 = $P1.record_separator() # default'
 187
 188     $S99 = 'abc'
 189     $P0.record_separator($S99)
 190     $S0 = $P0.record_separator()
 191     if $S0 == $S99 goto ok_2
 192     print 'not '
 193   ok_2:
 194     say 'ok 2 - $P0.record_separator($S1)'
 195
 196     $P0.print(123)
 197     $S0 = $P0.record_separator()
 198     $P0.print($S0)
 199     $P0.print(456)
 200
 201     $S0 = $P0.readline()
 202     if $S0 == '123abc' goto ok_3
 203     print 'not '
 204   ok_3:
 205     say 'ok 3 - $P0.record_separator() # .readline works as expected'
 206 .end
 207 CODE
 208 ok 1 - $S0 = $P1.record_separator() # default
 209 ok 2 - $P0.record_separator($S1)
 210 ok 3 - $P0.record_separator() # .readline works as expected
 211 OUT
 212
 213 # L<PDD22/I\/O PMC API/=item buffer_type>
 214 pir_output_is( <<'CODE', <<'OUT', 'buffer_type', todo => 'not yet implemented' );
 215 .sub 'test' :main
 216     .include 'io_buffer_types.pasm'
 217
 218     $P0 = new 'ParrotIO'
 219
 220     $P0.buffer_type('unbuffered')
 221     $I0 = $P0.buffer_type()
 222     if $I0 == PIO_NONBUF goto ok_1
 223     print 'not '
 224   ok_1:
 225     say 'ok 1 - $I0 = $P1.buffer_type() # PIO_NONBUF'
 226
 227     $P0.buffer_type(PIO_NONBUF)
 228     $S0 = $P0.buffer_type()
 229     if $S0 == 'unbuffered' goto ok_2
 230     print 'not '
 231   ok_2:
 232     say 'ok 2 - $S0 = $P1.buffer_type() # PIO_NONBUF'
 233
 234     $P0.buffer_type('line-buffered')
 235     $I0 = $P0.buffer_type()
 236     if $I0 == PIO_LINEBUF goto ok_3
 237     print 'not '
 238   ok_3:
 239     say 'ok 3 - $I0 = $P1.buffer_type() # PIO_LINEBUF'
 240
 241     $P0.buffer_type(PIO_LINEBUF)
 242     $S0 = $P0.buffer_type()
 243     if $S0 == 'line-buffered' goto ok_4
 244     print 'not '
 245   ok_4:
 246     say 'ok 4 - $S0 = $P1.buffer_type() # PIO_LINEBUF'
 247
 248     $P0.buffer_type('full-buffered')
 249     $I0 = $P0.buffer_type()
 250     if $I0 == PIO_FULLBUF goto ok_5
 251     print 'not '
 252   ok_5:
 253     say 'ok 5 - $I0 = $P1.buffer_type() # PIO_FULLBUF'
 254
 255     $P0.buffer_type(PIO_FULLBUF)
 256     $S0 = $P0.buffer_type()
 257     if $S0 == 'full-buffered' goto ok_6
 258     print 'not '
 259   ok_6:
 260     say 'ok 6 - $S0 = $P1.buffer_type() # PIO_FULLBUF'
 261 .end
 262 CODE
 263 ok 1 - $I0 = $P1.buffer_type() # PIO_NONBUF
 264 ok 2 - $S0 = $P1.buffer_type() # PIO_NONBUF
 265 ok 3 - $I0 = $P1.buffer_type() # PIO_LINEBUF
 266 ok 4 - $S0 = $P1.buffer_type() # PIO_LINEBUF
 267 ok 5 - $I0 = $P1.buffer_type() # PIO_FULLBUF
 268 ok 6 - $S0 = $P1.buffer_type() # PIO_FULLBUF
 269 OUT
 270
 271 # RT#46839 test effects of buffer_type, not just set/get
 272
 273 # RT#46841
 274 # L<PDD22/I\/O PMC API/=item buffer_size>
 275 # NOTES: try setting positive, zero, negative int
 276 # perform print and read ops
 277 # change buffer size while it contains data
 278 # try with all 'buffer_type' modes
 279
 280 # RT#46843
 281 # L<PDD22/I\/O PMC API/=item get_fd>
 282 # NOTES: this is going to be platform dependent
 283
 284 # Local Variables:
 285 #   mode: cperl
 286 #   cperl-indent-level: 4
 287 #   fill-column: 100
 288 # End:
 289 # vim: expandtab shiftwidth=4: