t/pmc/io_status.t

   1 #!perl
   2 # Copyright (C) 2006-2007, 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/io_status.t - test the Status PMC described in PDD22
  14
  15 =head1 SYNOPSIS
  16
  17     % prove t/pmc/io_status.t
  18
  19 =head1 DESCRIPTION
  20
  21 Tests the Status PMC described in PDD22.
  22
  23 =cut
  24
  25 # L<PDD22/Status Object PMC API/=item new>
  26 pir_output_is( <<'CODE', <<'OUT', 'new', todo => 'not yet implemented' );
  27 .sub 'test' :main
  28     new P0, 'Status'
  29     say "ok 1 - $P0 = new ['Status']"
  30 .end
  31 CODE
  32 ok 1 - $P0 = new ['Status']
  33 OUT
  34
  35 # L<PDD22/Status Object PMC API/=item get_integer (vtable)>
  36 pir_output_is( <<'CODE', <<'OUT', 'get_integer (vtable)', todo => 'not yet implemented' );
  37 .sub 'test' :main
  38     $P0 = new ['Status']
  39
  40     # TODO test more return values
  41     # TODO figure out how to set the values to make testing possible
  42     $I0 = $P0
  43
  44     if $I0 == 1 goto ok_1
  45     print 'not '
  46   ok_1:
  47     say 'ok 1 - $I0 = $P1 # success'
  48
  49     if $I0 == 0 goto ok_2
  50     print 'not '
  51   ok_2:
  52     say 'ok 2 - $I0 = $P1 # still running'
  53
  54     if $I0 == -1 goto ok_3
  55     print 'not '
  56   ok_3:
  57     say 'ok 3 - $I0 = $P1 # failure
  58 .end
  59 CODE
  60 ok 1 - $I0 = $P0 # success
  61 ok 2 - $I0 = $P0 # still running
  62 ok 3 - $I0 = $P0 # failure
  63 OUT
  64
  65 # L<PDD22/Status Object PMC API/=item get_bool (vtable)>
  66 pir_output_is( <<'CODE', <<'OUT', 'get_bool (vtable)', todo => 'not yet implemented' );
  67 .sub 'test' :main
  68     $P0 = new ['Status']
  69
  70     # TODO figure out how to set the values to make testing possible
  71
  72     if $P0 goto ok_1
  73     print 'not '
  74   ok_1:
  75     say 'ok 1 - $P0 # success'
  76
  77     if $P0 goto ok_2
  78     print 'not '
  79   ok_2:
  80     say 'ok 2 - $P0 # still running'
  81
  82     unless $P0 goto ok_3
  83     print 'not '
  84   ok_3:
  85     say 'ok 3 - $P0 # failure
  86 .end
  87 CODE
  88 ok 1 - $P0 # success
  89 ok 2 - $P0 # still running
  90 ok 3 - $P0 # failure
  91 OUT
  92
  93 # L<PDD22/Status Object PMC API/=item return>
  94 pir_output_is( <<'CODE', <<'OUT', 'return', todo => 'not yet implemented' );
  95 .sub 'test' :main
  96     $P0 = new ['Status']
  97
  98     # TODO test all return values
  99     # TODO figure out how to set the values to make testing possible
 100
 101     $P1 = $P0.return()
 102
 103     if $P1 goto ok_1
 104     print 'not '
 105   ok_1:
 106     say 'ok 1 - $P0 = $P1.return() # success'
 107
 108     # TODO test return value is expected value
 109
 110     if null $P1 goto ok_2
 111     print 'not '
 112   ok_2:
 113     say 'ok 2 - $P0 = $P1.return() # still running'
 114
 115     if null $P1 goto ok_3
 116     print 'not '
 117   ok_3:
 118     say 'ok 3 - $P0 = $P1.return() # no return value
 119 .end
 120 CODE
 121 ok 1 - $P0 = $P1.return() # success
 122 ok 2 - $P0 = $P1.return() # still running
 123 ok 3 - $P0 = $P1.return() # no return value
 124 OUT
 125
 126 # L<PDD22/Status Object PMC API/=item error>
 127 pir_output_is( <<'CODE', <<'OUT', 'error', todo => 'not yet implemented' );
 128 .sub 'test' :main
 129     $P0 = new ['Status']
 130
 131     # TODO test all error values
 132     # TODO figure out how to set the values to make testing possible
 133
 134     $P1 = $P0.error()
 135
 136     if null $P1 goto ok_1
 137     print 'not '
 138   ok_1:
 139     say 'ok 1 - $P0 = $P1.error() # success'
 140
 141     $P1 = $P0.error() # need still running here
 142
 143     if null $P1 goto ok_2
 144     print 'not '
 145   ok_2:
 146     say 'ok 2 - $P0 = $P1.error() # still running'
 147
 148     $P1 = $P0.error() # need real error here
 149
 150     unless null $P1 goto ok_3
 151     print 'not '
 152   ok_3:
 153     say 'ok 3 - $P0 = $P1.error() # got an error'
 154
 155     $I0 = isa $P1, 'Exception'
 156     if $I0 goto ok_4
 157     print 'not '
 158   ok_4:
 159     say 'ok 4 - $P0 = $P1.error() # error isa Exception'
 160
 161     # TODO test error value is expected value
 162
 163     $P1 = $P0.error() # need no error here
 164
 165     if null $P1 goto ok_5
 166     print 'not '
 167   ok_5:
 168     say 'ok 5 - $P0 = $P1.error() # no error
 169 .end
 170 CODE
 171 ok 1 - $P0 = $P1.error() # success
 172 ok 2 - $P0 = $P1.error() # still running
 173 ok 3 - $P0 = $P1.error() # got an error
 174 ok 4 - $P0 = $P1.error() # error isa Exception
 175 ok 5 - $P0 = $P1.error() # no error
 176 OUT
 177
 178 # L<PDD22/Status Object PMC API/=item throw>
 179 pir_output_is( <<'CODE', <<'OUT', 'throw', todo => 'not yet implemented' );
 180 .sub 'test' :main
 181     $P0 = new ['Status']
 182
 183     # TODO figure out how to set the values to make testing possible
 184
 185     push_eh eh_no_error
 186     $P0.throw()
 187     pop_eh eh_no_error
 188
 189     say 'ok 1 - $P0.throw() # no error'
 190
 191   test_2:
 192     $P0 = new ['Status'] # need error here
 193
 194     push_eh eh_error
 195     $P0.throw()
 196     pop_eh
 197
 198     say 'not ok 2 - $P0.throw() # error'
 199
 200     goto end
 201
 202   eh_no_error:
 203     say 'not ok 1 - $P0.throw() # no error'
 204     goto test_2
 205
 206   eh_error:
 207     say 'ok 2 - $P0.throw() # error'
 208
 209   end:
 210 .end
 211 CODE
 212 ok 1 - $P1.throw() # no error
 213 ok 2 - $P1.throw() # error
 214 OUT
 215
 216 # Local Variables:
 217 #   mode: cperl
 218 #   cperl-indent-level: 4
 219 #   fill-column: 100
 220 # End:
 221 # vim: expandtab shiftwidth=4: