t/pmc/parrotinterpreter.t

   1 #!./parrot
   2 # Copyright (C) 2006-2010, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/pmc/parrotinterpreter.t - test the ParrotInterpreter PMC
   8
   9
  10 =head1 SYNOPSIS
  11
  12     % prove t/pmc/parrotinterpreter.t
  13
  14 =head1 DESCRIPTION
  15
  16 Tests the ParrotInterpreter PMC.
  17
  18 =cut
  19
  20 .include 'except_types.pasm'
  21
  22 .sub main :main
  23 .include 'test_more.pir'
  24
  25     plan(13)
  26     test_new()      # 1 test
  27     test_hll_map()  # 3 tests
  28     test_hll_map_invalid()  # 1 tests
  29
  30 # Need for testing
  31 .annotate 'foo', 'bar'
  32     test_inspect()  # 8 tests
  33 .end
  34
  35 .sub test_new
  36     new $P0, ['ParrotInterpreter']
  37     ok(1,'new')
  38 .end
  39
  40 .HLL 'Perl6'
  41
  42 .sub test_hll_map
  43 .include 'test_more.pir'
  44     $P0 = get_class 'Integer'
  45     $P1 = subclass $P0, 'MyInt'
  46
  47     $P2 = getinterp
  48     $P2.'hll_map'($P0, $P1)
  49
  50     $P3 = 'foo'()
  51     is($P3, 3)
  52     $S0 = typeof $P3
  53     is($S0, "MyInt")
  54     bar(4)
  55 .end
  56
  57 .sub foo
  58     .return (3)
  59 .end
  60
  61 .sub bar
  62     .param pmc n
  63     $S0 = typeof n
  64     is($S0, 'MyInt')
  65 .end
  66
  67 # Switch back to root namespace
  68 .HLL 'parrot'
  69
  70 .sub test_hll_map_invalid
  71     .local pmc eh
  72     .local int result
  73     $P0 = get_class 'Integer'
  74     $P1 = subclass $P0, 'MyInt'
  75     $P2 = getinterp
  76     eh = new ['ExceptionHandler']
  77     set_label eh, catch
  78     eh.'handle_types'(.EXCEPTION_INVALID_OPERATION)
  79     result = 0
  80     push_eh eh
  81     $P2.'hll_map'($P0, $P1)
  82     goto done
  83   catch:
  84     finalize eh
  85     result = 1
  86   done:
  87     is(result, 1, 'hll_map outside an HLL throws')
  88 .end
  89
  90 # Test accessors to various Interp fields
  91 .sub 'test_inspect'
  92     .local pmc interp
  93     interp = getinterp
  94
  95     # Enforce creating of lexpad
  96     .lex 'foo', interp
  97
  98     $P0 = interp['sub';0]
  99     is($P0, 'test_inspect', 'Got ParrotInterp.sub')
 100
 101     $P0 = interp['lexpad';0]
 102     $I0 = isa $P0, 'LexPad'
 103     ok($I0, 'Got ParrotInterp.lexpad')
 104
 105     $P0 = interp['namespace';0]
 106     $I0 = isa $P0, 'NameSpace'
 107     ok($I0, 'Got ParrotInterp.namespace')
 108
 109     $P0 = interp['continuation';0]
 110     $I0 = isa $P0, 'Continuation'
 111     ok($I0, 'Got ParrotInterp.continuation')
 112
 113     $P0 = interp['annotations';1]
 114     $S0 = $P0['foo']
 115     is($S0, 'bar', 'Got ParrotInterp.annotations')
 116
 117     $P0 = interp['context';0]
 118     $I0 = isa $P0, 'CallContext'
 119     ok($I0, 'Got ParrotInterp.context')
 120     # Add more tests for Context. E.g. it is correct Context by inspecting it.
 121
 122     push_eh caught
 123     $I0 = 1
 124     $P0 = interp['some_field';0]
 125     $I0 = 0
 126   caught:
 127     pop_eh
 128     ok($I0, "Access to non-existent field throws exception")
 129
 130     push_eh wrong_depth
 131     $I0 = 1
 132     $P0 = interp['sub';1000]
 133     $I0 = 0
 134   wrong_depth:
 135     pop_eh
 136     ok($I0, "Access to wrong depth throws exception")
 137
 138 .end
 139
 140 # Local Variables:
 141 #   mode: pir
 142 #   fill-column: 100
 143 # End:
 144 # vim: expandtab shiftwidth=4 ft=pir: