t/pmc/parrotio.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 use Test::More;
   9 use Parrot::Test tests => 6;
  10
  11 =head1 NAME
  12
  13 t/pmc/parrotio.t - test the FileHandle PMC
  14
  15 =head1 SYNOPSIS
  16
  17     % prove t/pmc/parrotio.t
  18
  19 =head1 DESCRIPTION
  20
  21 Tests the FileHandle 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, ['FileHandle']
  29     say "ok 1 - $P0 = new ['FileHandle']"
  30 .end
  31 CODE
  32 ok 1 - $P0 = new ['FileHandle']
  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 ['FileHandle']
  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 # should be in the PIR code
  82 unlink 'new_file';
  83
  84 SKIP: {
  85     skip 'no asynch calls yet' => 1;
  86
  87     pir_output_is( <<'CODE', <<'OUT', 'open and close - asynchronous' );
  88 .sub 'test' :main
  89     $P1 = # TT #1204 create a callback here
  90     $P0 = new ['FileHandle']
  91
  92     $P0.open('README')
  93     say 'ok 1 - $P0.open($S1)'
  94
  95     $P0.close()
  96     say 'ok 2 - $P0.close($P1)'
  97
  98     $P0.open('README', 'rw')
  99     say 'ok 3 - $P0.open($S1, $S2)'
 100
 101     $P0.close()
 102     $P0.open()
 103     say 'ok 4 - $P0.open()'
 104
 105   cleanup:
 106     $P0.close()
 107 .end
 108 CODE
 109 ok 1 - $P0.open($S1)
 110 ok 2 - $P0.close()
 111 ok 3 - $P0.open($S1, $S2)
 112 ok 4 - $P0.open()
 113 OUT
 114 }
 115
 116 # L<PDD22/I\/O PMC API/=item print.*=item readline>
 117 pir_output_is(
 118     <<'CODE', <<'OUT', 'print, read, and readline - synchronous', todo => 'not yet implemented' );
 119 .sub 'test' :main
 120     load_bytecode 'String/Utils.pbc'
 121     .local pmc chomp
 122                chomp = get_global ['String';'Utils'], 'chomp'
 123
 124     $P0 = new ['FileHandle']
 125     $P0.open('README')
 126
 127     $S0 = $P0.read(14) # bytes
 128     if $S0 == 'This is Parrot' goto ok_1
 129     print 'not '
 130   ok_1:
 131     say 'ok 1 - $S0 = $P1.read($I2)'
 132
 133     $S0 = $P0.read(9)  # bytes
 134     if $S0 == ', version' goto ok_2
 135     print 'not '
 136   ok_2:
 137     say 'ok 2 - $S0 = $P1.read($I2)     # again on same stream'
 138
 139     $P0.print(123)
 140     $P0.print(456.789)
 141     $P0.print("squawk\n")
 142     $P1 = new ['Integer']
 143     $P1 = 42
 144     $P0.print($P1)
 145     say 'ok 3 - $P0.print(${I,N,S,P}1)'
 146
 147     $S0 = $P0.readline()
 148     $S0 = chomp( $S0 )
 149     if $S0 == '123456.789000squawk' goto ok_4
 150     print 'not '
 151   ok_4:
 152     say 'ok 4 - $S0 = $P1.readline($I2)'
 153
 154     $S0 = $P0.readline()
 155     $S0 = chomp( $S0 )
 156     if $S0 == '42' goto ok_5
 157     print 'not '
 158   ok_5:
 159     say 'ok 5 - $S0 = $P1.readline($I2) # again on same stream'
 160 .end
 161 CODE
 162 ok 1 - $S0 = $P1.read($I2)
 163 ok 2 - $S0 = $P1.read($I2)     # again on same stream
 164 ok 3 - $P0.print(${I,N,S,P}1)
 165 ok 4 - $S0 = $P1.readline($I2)
 166 ok 5 - $S0 = $P1.readline($I2) # again on same stream
 167 OUT
 168
 169 # TT #1204 test reading long chunks, eof, and across newlines
 170
 171 # TT #1204 pir_output_is( <<'CODE', <<'OUT', 'print, read, and readline - asynchronous', todo => 'not yet implemented' );
 172
 173 # L<PDD22/I\/O PMC API/=item record_separator>
 174 pir_output_is( <<'CODE', <<'OUT', 'record_separator', todo => 'not yet implemented' );
 175 .sub 'test' :main
 176     $P0 = new ['FileHandle']
 177
 178     $S0 = $P0.record_separator()
 179     if $S0 == "\n" goto ok_1
 180     print 'not '
 181   ok_1:
 182     say 'ok 1 - $S0 = $P1.record_separator() # default'
 183
 184     $S99 = 'abc'
 185     $P0.record_separator($S99)
 186     $S0 = $P0.record_separator()
 187     if $S0 == $S99 goto ok_2
 188     print 'not '
 189   ok_2:
 190     say 'ok 2 - $P0.record_separator($S1)'
 191
 192     $P0.print(123)
 193     $S0 = $P0.record_separator()
 194     $P0.print($S0)
 195     $P0.print(456)
 196
 197     $S0 = $P0.readline()
 198     if $S0 == '123abc' goto ok_3
 199     print 'not '
 200   ok_3:
 201     say 'ok 3 - $P0.record_separator() # .readline works as expected'
 202 .end
 203 CODE
 204 ok 1 - $S0 = $P1.record_separator() # default
 205 ok 2 - $P0.record_separator($S1)
 206 ok 3 - $P0.record_separator() # .readline works as expected
 207 OUT
 208
 209 # L<PDD22/I\/O PMC API/=item buffer_type>
 210 pir_output_is( <<'CODE', <<'OUT', 'buffer_type', todo => 'not yet implemented' );
 211 .sub 'test' :main
 212     .include 'io_buffer_types.pasm'
 213
 214     $P0 = new ['FileHandle']
 215
 216     $P0.buffer_type('unbuffered')
 217     $I0 = $P0.buffer_type()
 218     if $I0 == PIO_NONBUF goto ok_1
 219     print 'not '
 220   ok_1:
 221     say 'ok 1 - $I0 = $P1.buffer_type() # PIO_NONBUF'
 222
 223     $P0.buffer_type(PIO_NONBUF)
 224     $S0 = $P0.buffer_type()
 225     if $S0 == 'unbuffered' goto ok_2
 226     print 'not '
 227   ok_2:
 228     say 'ok 2 - $S0 = $P1.buffer_type() # PIO_NONBUF'
 229
 230     $P0.buffer_type('line-buffered')
 231     $I0 = $P0.buffer_type()
 232     if $I0 == PIO_LINEBUF goto ok_3
 233     print 'not '
 234   ok_3:
 235     say 'ok 3 - $I0 = $P1.buffer_type() # PIO_LINEBUF'
 236
 237     $P0.buffer_type(PIO_LINEBUF)
 238     $S0 = $P0.buffer_type()
 239     if $S0 == 'line-buffered' goto ok_4
 240     print 'not '
 241   ok_4:
 242     say 'ok 4 - $S0 = $P1.buffer_type() # PIO_LINEBUF'
 243
 244     $P0.buffer_type('full-buffered')
 245     $I0 = $P0.buffer_type()
 246     if $I0 == PIO_FULLBUF goto ok_5
 247     print 'not '
 248   ok_5:
 249     say 'ok 5 - $I0 = $P1.buffer_type() # PIO_FULLBUF'
 250
 251     $P0.buffer_type(PIO_FULLBUF)
 252     $S0 = $P0.buffer_type()
 253     if $S0 == 'full-buffered' goto ok_6
 254     print 'not '
 255   ok_6:
 256     say 'ok 6 - $S0 = $P1.buffer_type() # PIO_FULLBUF'
 257 .end
 258 CODE
 259 ok 1 - $I0 = $P1.buffer_type() # PIO_NONBUF
 260 ok 2 - $S0 = $P1.buffer_type() # PIO_NONBUF
 261 ok 3 - $I0 = $P1.buffer_type() # PIO_LINEBUF
 262 ok 4 - $S0 = $P1.buffer_type() # PIO_LINEBUF
 263 ok 5 - $I0 = $P1.buffer_type() # PIO_FULLBUF
 264 ok 6 - $S0 = $P1.buffer_type() # PIO_FULLBUF
 265 OUT
 266
 267 # TT #1204 test effects of buffer_type, not just set/get
 268
 269 # TT #1177
 270 # L<PDD22/I\/O PMC API/=item buffer_size>
 271 # NOTES: try setting positive, zero, negative int
 272 # perform print and read ops
 273 # change buffer size while it contains data
 274 # try with all 'buffer_type' modes
 275
 276 # TT #1178
 277 # L<PDD22/I\/O PMC API/=item get_fd>
 278 # NOTES: this is going to be platform dependent
 279
 280 # Local Variables:
 281 #   mode: cperl
 282 #   cperl-indent-level: 4
 283 #   fill-column: 100
 284 # End:
 285 # vim: expandtab shiftwidth=4: