t/pmc/context.t

   1 #! parrot
   2 # Copyright (C) 2009, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/pmc/context.t - test Context PMC
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/pmc/context.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests the Context PMC.
  16
  17 TODO: Implement real tests when Context PMC will be migrated to use ATTRibutes.
  18
  19 =cut
  20
  21 .HLL 'FOO'
  22
  23 .sub main :main
  24     .include 'test_more.pir'
  25
  26     plan(19)
  27
  28     test_new()
  29
  30     $P0 = get_hll_global ['Foo'], 'load'
  31     $P0()
  32     $P0 = new ['Foo']
  33     $P0.'test_inspect'() # 16 tests
  34
  35     test_backtrace()     # 3 tests
  36 .end
  37
  38 .sub 'test_new'
  39     $P0 = new ['Context']
  40     sweep 1
  41     ok(1, 'Instantiated .Context')
  42 .end
  43
  44 # Put test_inspect into Namespace, as method, with outer, etc.
  45 .namespace ['Foo']
  46
  47 .sub 'load'
  48     $P0 = newclass 'Foo'
  49 .end
  50
  51 .sub 'test_inspect' :method :outer('load')
  52     .include 'test_more.pir'
  53
  54     .local pmc ctx
  55
  56     # We need LexPad
  57     .lex 'foo_ctx', ctx
  58
  59     $P0 = getinterp
  60     ctx = $P0['context']
  61     $I0 = defined ctx
  62     ok($I0, "Got Context")
  63
  64     # Check current_sub first. Other tests relying on it
  65     $P0 = ctx['current_sub']
  66     is($P0, 'test_inspect', 'Got Context.current_sub')
  67
  68     $P0 = ctx['caller_ctx']
  69     $I0 = isa $P0, 'Context'
  70     ok($I0, 'Got Context.caller_ctx')
  71     $P0 = $P0['current_sub']
  72     is($P0, 'main', '... from proper Sub')
  73
  74     $P0 = ctx['outer_ctx']
  75     $I0 = isa $P0, 'Context'
  76     ok($I0, 'Got Context.outer_ctx')
  77     $P0 = $P0['current_sub']
  78     is($P0, 'load', '... from proper Sub')
  79
  80     $P0 = ctx['lex_pad']
  81     $I0 = isa $P0, 'LexPad'
  82     ok($I0, 'Got Context.lex_pad')
  83     $P1 = $P0['foo_ctx']
  84     $I0 = defined $P1
  85     ok($I0, '... with proper content')
  86
  87     $P0 = ctx['current_cont']
  88     $I0 = isa $P0, 'Continuation'
  89     ok($I0, 'Got Context.current_cont')
  90
  91     $P0 = ctx['current_object']
  92     $I0 = isa $P0, 'Foo'
  93     ok($I0, 'Got Context.current_object')
  94
  95     $P0 = ctx['current_namespace']
  96     ok($P0, 'Got Context.current_namespace')
  97     $P1 = $P0['test_inspect']
  98     is($P1, 'test_inspect', '... with proper content')
  99
 100     # Checking handlers
 101     push_eh done
 102     $P0 = ctx['handlers']
 103     $I0 = elements $P0
 104
 105     push_eh cought
 106     # Now we should have one more handler
 107     $P0 = ctx['handlers']
 108     $I1 = elements $P0
 109     dec $I1
 110     is($I0, $I1, 'Got Context.handlers')
 111
 112     # Check absurd fields
 113     $I0 = 1
 114     $P0 = ctx['world_domination']
 115     $I0 = 0
 116   cought:
 117     pop_eh
 118     ok($I0, "No world domination in this Context")
 119
 120     # Current HLL shouldn't be zero
 121     $P0 = ctx['current_HLL']
 122     $I0 = $P0
 123     ok($I0, 'Got Context.current_HLL')
 124
 125     $P0 = ctx['current_hll']
 126     ok($P0, 'FOO', 'Got Context.current_hll')
 127
 128   done:
 129     pop_eh
 130
 131 .end
 132
 133 .namespace []
 134
 135 .sub 'test_backtrace'
 136     .local pmc bt
 137     bt = 'test_bt1'()
 138     $I0 = defined bt
 139     ok($I0, "Got Context.backtrace()")
 140
 141     # We should have more than 3 elements
 142     $I0 = elements bt
 143     $I1 = $I0 > 3
 144     ok($I1, "... got enough elements")
 145
 146     # First one should be "test_bt2"
 147     $P1 = shift bt
 148     $P2 = $P1['sub']
 149     is($P2, 'test_bt2', "... with correct first element")
 150 .end
 151
 152 .sub 'test_bt1'
 153     $P0 = 'test_bt2'()
 154     .return ($P0)
 155 .end
 156
 157 .sub 'test_bt2'
 158     $P0 = getinterp
 159     $P1 = $P0['context']
 160     $P2 = $P1.'backtrace'()
 161     .return ($P2)
 162 .end
 163
 164 # Local Variables:
 165 #   mode: pir
 166 #   fill-column: 100
 167 # End:
 168 # vim: expandtab shiftwidth=4 ft=pir: