t/op/fetch.t

   1 #!./parrot
   2 # Copyright (C) 2009-2010, 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     $P0    = new [ 'Hash' ]
  32     $P1    = box 111
  33     $P0[1] = $P1
  34     $P0[3] = $P1
  35
  36     $P3 = fetch $P0, 1, [ 'Integer' ]
  37     is( $P3, 111, 'fetch should return existing element unmodified' )
  38     $P1 = 123
  39     is( $P3, 123, '... the exact PMC itself' )
  40
  41     $P3 = fetch $P0, 3, [ 'Integer' ]
  42     is( $P3, 123, '... even if stored in multiple locations' )
  43
  44     $P3 = fetch $P0, 2, [ 'Integer' ]
  45     is( $P3, 0, 'fetch should create new PMC if not-existent' )
  46     isa_ok( $P3, 'Integer', 'new PMC should have type Integer' )
  47 .end
  48
  49 .sub 'test_fetch_keyed_str'
  50     $P0          = new [ 'Hash' ]
  51     $P1          = box 111
  52     $P0['one']   = $P1
  53     $P0['three'] = $P1
  54
  55     $P3 = fetch $P0, 'one', [ 'Integer' ]
  56     is( $P3, 111, 'fetch should return existing element unmodified' )
  57     $P1 = 123
  58     is( $P3, 123, '... the exact PMC itself' )
  59
  60     $P3 = fetch $P0, 'three', [ 'Integer' ]
  61     is( $P3, 123, '... even if stored in multiple locations' )
  62
  63     $P3 = fetch $P0, 'two', [ 'Integer' ]
  64     is( $P3, 0, 'fetch should create new PMC if not-existent' )
  65     isa_ok( $P3, 'Integer', 'new PMC should have type Integer' )
  66 .end
  67
  68 .sub 'test_fetch_keyed_pmc'
  69     $P0          = new [ 'Hash' ]
  70     $P1          = box 111
  71
  72     .local pmc str_key
  73     str_key      = box 'foo'
  74     $P0[str_key] = $P1
  75
  76     .local pmc int_key
  77     int_key      = box 435
  78     $P0[int_key] = $P1
  79
  80     $P3          = fetch $P0, str_key, [ 'String' ]
  81     is( $P3, 111, 'fetch should return existing element unmodified' )
  82
  83     $P1          = 123
  84     is( $P3, 123, '... the exact PMC itself' )
  85
  86     $P3 = fetch $P0, int_key, [ 'String' ]
  87     is( $P3, 123, '... even if stored in multiple locations' )
  88
  89     str_key = 'baz'
  90     $P3 = fetch $P0, str_key, [ 'String' ]
  91     is( $P3, '', 'fetch should return new PMC if keyed PMC is not there' )
  92     isa_ok( $P3, 'String', 'new PMC should have given type' )
  93
  94     int_key = 789
  95     $P3 = fetch $P0, str_key, [ 'String' ]
  96     is( $P3, '', 'fetch should return new PMC if keyed PMC is not there' )
  97     isa_ok( $P3, 'String', 'new PMC should have given type' )
  98 .end
  99
 100 # Local Variables:
 101 #   mode: pir
 102 #   fill-column: 100
 103 # End:
 104 # vim: expandtab shiftwidth=4 ft=pir: