t/op/fetch.t

   1 #!parrot
   2 # Copyright (C) 2009, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/op/fetch.t - the fetch opcode
   8
   9 =head1 SYNOPSIS
  10
  11      % prove t/op/fetch.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests Parrot's experimental fetch opcode.
  16
  17 =cut
  18
  19 .sub 'main' :main
  20     .include 'test_more.pir'
  21
  22     plan(17)
  23
  24     test_fetch_keyed_pmc()
  25     test_fetch_keyed_int()
  26     test_fetch_keyed_str()
  27     # END_OF_TESTS
  28 .end
  29
  30 .sub 'test_fetch_keyed_int'
  31     diag( 'test_fetch_keyed_int' )
  32     $P0    = new [ 'Hash' ]
  33     $P1    = box 111
  34     $P0[1] = $P1
  35     $P0[3] = $P1
  36
  37     $P3 = fetch $P0, 1, [ 'Integer' ]
  38     is( $P3, 111, 'fetch should return existing element unmodified' )
  39     $P1 = 123
  40     is( $P3, 123, '... the exact PMC itself' )
  41
  42     $P3 = fetch $P0, 3, [ 'Integer' ]
  43     is( $P3, 123, '... even if stored in multiple locations' )
  44
  45     $P3 = fetch $P0, 2, [ 'Integer' ]
  46     is( $P3, 0, 'fetch should create new PMC if not-existent' )
  47     isa_ok( $P3, 'Integer', 'new PMC should have type Integer' )
  48 .end
  49
  50 .sub 'test_fetch_keyed_str'
  51     diag( 'test_fetch_keyed_str' )
  52     $P0          = new [ 'Hash' ]
  53     $P1          = box 111
  54     $P0['one']   = $P1
  55     $P0['three'] = $P1
  56
  57     $P3 = fetch $P0, 'one', [ 'Integer' ]
  58     is( $P3, 111, 'fetch should return existing element unmodified' )
  59     $P1 = 123
  60     is( $P3, 123, '... the exact PMC itself' )
  61
  62     $P3 = fetch $P0, 'three', [ 'Integer' ]
  63     is( $P3, 123, '... even if stored in multiple locations' )
  64
  65     $P3 = fetch $P0, 'two', [ 'Integer' ]
  66     is( $P3, 0, 'fetch should create new PMC if not-existent' )
  67     isa_ok( $P3, 'Integer', 'new PMC should have type Integer' )
  68 .end
  69
  70 .sub 'test_fetch_keyed_pmc'
  71     diag( 'test_fetch_keyed_pmc' )
  72     $P0          = new [ 'Hash' ]
  73     $P1          = box 111
  74
  75     .local pmc str_key
  76     str_key      = box 'foo'
  77     $P0[str_key] = $P1
  78
  79     .local pmc int_key
  80     int_key      = box 435
  81     $P0[int_key] = $P1
  82
  83     $P3          = fetch $P0, str_key, [ 'String' ]
  84     is( $P3, 111, 'fetch should return existing element unmodified' )
  85
  86     $P1          = 123
  87     is( $P3, 123, '... the exact PMC itself' )
  88
  89     $P3 = fetch $P0, int_key, [ 'String' ]
  90     is( $P3, 123, '... even if stored in multiple locations' )
  91
  92     str_key = 'baz'
  93     $P3 = fetch $P0, str_key, [ 'String' ]
  94     is( $P3, '', 'fetch should return new PMC if keyed PMC is not there' )
  95     isa_ok( $P3, 'String', 'new PMC should have given type' )
  96
  97     int_key = 789
  98     $P3 = fetch $P0, str_key, [ 'String' ]
  99     is( $P3, '', 'fetch should return new PMC if keyed PMC is not there' )
 100     isa_ok( $P3, 'String', 'new PMC should have given type' )
 101 .end
 102
 103 # Local Variables:
 104 #   mode: pir
 105 #   cperl-indent-level: 4
 106 #   fill-column: 100
 107 # End:
 108 # vim: expandtab shiftwidth=4 ft=pir :