t/pmc/prop.t

   1 #! parrot
   2 # Copyright (C) 2001-2005, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/pmc/prop.t - Properties
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/pmc/prop.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests property access on PMCs.
  16
  17 =cut
  18
  19 .sub main :main
  20     .include 'test_more.pir'
  21     plan(15)
  22
  23     setprop_getprop_tests()
  24     prop_vals_are_refs()
  25     prop_reset()
  26     get_unset_prop()
  27     delprop_tests()
  28     prophash_tests()
  29 .end
  30
  31
  32 .sub setprop_getprop_tests
  33     new $P0, ['Integer']
  34     set $P0, 10
  35     new $P1, ['String']
  36     set $P1, "ten"
  37     setprop $P0, "en", $P1
  38     new $P2, ['String']
  39     set $P2, "zehn"
  40     setprop $P0, "de", $P2
  41     is($P0, "10", "setprop is ok")
  42     getprop $P3, "en", $P0
  43     is($P3, "ten", "getprop is ok")
  44     getprop $P3, "de", $P0
  45     is($P3, "zehn", "getprop is ok")
  46 .end
  47
  48 .sub prop_vals_are_refs
  49     new $P0, ['String']
  50     new $P1, ['String']
  51     set $P0, "Dog"
  52
  53     set $S0, "Brown"
  54     set $P1, "Yes"
  55     setprop $P0, $S0, $P1
  56
  57     set $S0, "Black"
  58     set $P1, "No"
  59     setprop $P0, $S0, $P1
  60     new $P2, ['String']
  61     getprop $P2, "Black", $P0
  62     is($P2, "No", "'Black' property refers to right string")
  63     getprop $P2, "Brown", $P0
  64     is($P2, "No", "'Brown' property refers to same string as 'Black'")
  65 .end
  66
  67 .sub prop_reset
  68     new $P0, ['ResizablePMCArray']
  69     new $P1, ['String']
  70     new $P2, ['String']
  71     new $P3, ['String']
  72
  73     set $S0, "Type"
  74     set $P1, "Integer"
  75     setprop $P0, $S0, $P1
  76     getprop $P2, $S0, $P0
  77     is($P2, "Integer", "'Type' property successfully set to Integer'")
  78     set $P3, "Float"
  79     setprop $P0, $S0, $P3
  80     getprop $P2, $S0, $P0
  81     is($P2, "Float", "'Type' property successfully changed to Float'")
  82 .end
  83
  84 .sub get_unset_prop
  85     new $P1, ['Float']
  86     new $P2, ['Integer']
  87
  88     getprop $P2, "Wibble", $P1
  89     defined $I2, $P2
  90     is($I2, 0, "unset property isn't defined")
  91 .end
  92
  93 .sub delprop_tests
  94     new $P0, ['Integer']
  95     set $P0, 10
  96     new $P1, ['String']
  97     set $P1, "ten"
  98     setprop $P0, "en", $P1
  99     new $P2, ['String']
 100     set $P2, "zehn"
 101     setprop $P0, "de", $P2
 102     is($P0, "10", "ok")
 103     getprop $P3, "en", $P0
 104     is($P3, "ten", "ok")
 105     getprop $P3, "de", $P0
 106     is($P3, "zehn", "ok")
 107     delprop $P0, "de"
 108     getprop $P3, "de", $P0
 109     if_null $P3, ok
 110     ok(0, "'de' property not deleted")
 111     goto end
 112 ok:
 113     ok(1, "'de' property deleted")
 114 end:
 115 .end
 116
 117 .sub prophash_tests
 118     new $P0, ['Integer']
 119     set $P0, 10
 120     new $P1, ['String']
 121     set $P1, "ten"
 122     setprop $P0, "en", $P1
 123     new $P2, ['String']
 124     set $P2, "zehn"
 125     setprop $P0, "de", $P2
 126     prophash $P3, $P0
 127     set $S0, $P3["en"]
 128     is($S0, "ten", "getprop via prophash works")
 129     set $S0, $P3["de"]
 130     is($S0, "zehn", "getprop via prophash works")
 131     set $S0, $P3["xx"]
 132     is($S0, "", "getprop via prophash works for unset prop")
 133 .end
 134
 135 # Local Variables:
 136 #   mode: pir
 137 #   cperl-indent-level: 4
 138 #   fill-column: 100
 139 # End:
 140 # vim: expandtab shiftwidth=4 ft=pir: