t/pmc/fixedfloatarray.t

   1 #!./parrot
   2 # Copyright (C) 2001-2010, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/pmc/fixedfloatarray.t - FixedFloatArray PMC
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/pmc/fixedfloatarray.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests C<FixedFloatArray> PMC. Checks size, sets various elements, including
  16 out-of-bounds test. Checks INT and PMC keys.
  17
  18 =cut
  19
  20 .sub main :main
  21     .include 'fp_equality.pasm'
  22     .include 'test_more.pir'
  23     plan(30)
  24
  25     array_size_tests()
  26     element_set_tests()
  27     oob_tests()
  28     set_and_get_tests()
  29     clone_tests()
  30     what_is_truth()
  31     interface_check()
  32     get_iter_test()
  33     test_new_style_init()
  34     test_invalid_init_tt1509()
  35 .end
  36
  37 .sub array_size_tests
  38     $P0 = new ['FixedFloatArray']
  39
  40     set $I0,$P0
  41     is($I0, 0, "initial size is 0")
  42
  43     set $P0,1
  44     $I0 = $P0
  45     is($I0, 1, "changed size is 1")
  46
  47     push_eh eh
  48     set $P0, 666
  49     pop_eh
  50     ok(0, "no exception when changing size")
  51     goto end
  52 eh:
  53     ok(1, "exception thrown when changing size")
  54 end:
  55 .end
  56
  57
  58 .sub element_set_tests
  59     $P0 = new ['FixedFloatArray']
  60     set $P0, 1
  61
  62     set $P0[0],-7
  63     set $I0,$P0[0]
  64     is($I0, -7, "ok")
  65
  66     set $P0[0],3.7
  67     set $N0,$P0[0]
  68     is($N0, 3.7, "ok")
  69
  70     set $P0[0],"17.2"
  71     set $S0,$P0[0]
  72     is($S0, "17.2", "ok")
  73
  74     $P0 = new ['FixedFloatArray']
  75     set $P0, 2
  76
  77     set $P0[1], -7
  78     set $I0, $P0[1]
  79     is($I0, -7, "ok")
  80
  81     set $P0[1], 3.7
  82     set $N0, $P0[1]
  83     is($N0, 3.7, "ok")
  84
  85     set $P0[1],"17.1"
  86     set $S0, $P0[1]
  87     is($S0, "17.1")
  88
  89 .end
  90
  91 .sub oob_tests
  92     $P0 = new ['FixedFloatArray']
  93     set $P0, 1
  94
  95     push_eh eh1
  96     set $P0[1], -7
  97     pop_eh
  98     ok(0, "no exception raised when setting nonexistant element")
  99     goto after_eh1
 100 eh1:
 101     ok(1, "exception raised when setting nonexistant element")
 102 after_eh1:
 103
 104     push_eh eh2
 105     set $I0, $P0[1]
 106     pop_eh
 107     ok(0, "no exception raised when getting nonexistant element")
 108     goto after_eh2
 109 eh2:
 110     ok(1, "exception raised when getting nonexistant element")
 111 after_eh2:
 112 .end
 113
 114
 115 .sub set_and_get_tests
 116      $P0 = new ['FixedFloatArray']
 117      set $P0, 3
 118      $P1 = new ['Key']
 119
 120      set $P1, 0
 121      set $P0[$P1], 25
 122      set $P1, 1
 123      set $P0[$P1], 2.5
 124      set $P1, 2
 125      set $P0[$P1], "17.32"
 126
 127      set $I0, $P0[0]
 128      is($I0, 25, "set int via PMC Key, get via int")
 129
 130      set $N0, $P0[1]
 131      .fp_eq($N0, 2.5, ok1)
 132      ok(0, "set num via PMC Key, get via int")
 133      goto after_ok1
 134 ok1:
 135      ok(1, "set num via PMC Key, get via int")
 136 after_ok1:
 137
 138      set $S0, $P0[2]
 139      is($S0, "17.32", "set string via PMC Key, get via int")
 140
 141
 142      $P0 = new ['FixedFloatArray']
 143      set $P0, 1024
 144
 145      set $P0[25], 125
 146      set $P0[128], 10.2
 147      set $P0[513], "17.3"
 148      $P1 = new ['Integer']
 149      set $P1, 123456
 150      set $P0[1023], $P1
 151
 152      $P2 = new ['Key']
 153      set $P2, 25
 154      set $I0, $P0[$P2]
 155      is($I0, 125, "set int via int, get via PMC Key")
 156
 157      set $P2, 128
 158      set $N0, $P0[$P2]
 159      .fp_eq($N0, 10.2, ok2)
 160      ok(0, "set num via int, get via PMC Key")
 161      goto after_ok2
 162 ok2:
 163      ok(1, "set num via int, get via PMC Key")
 164 after_ok2:
 165
 166      set $P2, 513
 167      set $S0, $P0[$P2]
 168      is($S0, "17.3", "set string via int, get via PMC Key")
 169
 170      set $P2, 1023
 171      set $P3, $P0[$P2]
 172      set $I1, $P3
 173      is($I1, 123456, "set PMC via int, get via PMC Key")
 174 .end
 175
 176
 177 .sub clone_tests
 178      set $I30, 2000
 179      $P0 = new ['FixedFloatArray']
 180      $I1 = 0
 181      clone $P2, $P0
 182      if $P2 goto L0
 183      $I1 = 1
 184 L0:  is($I1, 1, "clone of empty is empty")
 185
 186      set $P0, $I30
 187      set $I0, 0
 188 L1:  set $N0, $I0
 189      set $P0[$I0], $N0
 190      inc $I0
 191      lt $I0, $I30, L1
 192
 193      clone $P1, $P0
 194
 195 L2:  dec $I0
 196      set $N0, $I0
 197      set $N1, $P0[$I0]
 198      .fp_ne($N0, $N1, BAD)
 199      gt $I0, 0, L2
 200      ok(1, "clone made a good clone")
 201      goto end
 202
 203 BAD:
 204      ok(0, "clone made an evil clone")
 205      say $N0
 206      say $N1
 207 end:
 208 .end
 209
 210
 211 .sub what_is_truth
 212     $P0 = new ['FixedFloatArray']
 213     $I0 = $P0
 214     is($I0, 0, "an empty FixedFloatArray is false")
 215     set $P0, 1
 216     $I0 = $P0
 217     is($I0, 1, "a non-empty FixedFloatArray is true")
 218 .end
 219
 220
 221 .sub interface_check
 222     .local pmc p
 223     p = new ['FixedFloatArray']
 224     .local int b
 225     does b, p, "scalar"
 226     is(b, 0, "FFA does not do scalar")
 227     does b, p, "array"
 228     is(b, 1, "FFA does array")
 229     does b, p, "no_interface"
 230     is(b, 0, "FFA does not do no_interface")
 231 .end
 232
 233 .sub get_iter_test
 234     $P0 = new ['FixedFloatArray']
 235     $P0 = 3
 236     $P0[0] = 1.1
 237     $P0[1] = 99.99
 238     $P0[2] = -345.001
 239     $P1 = iter $P0
 240 loop:
 241     unless $P1 goto loop_end
 242     $S2 = shift $P1
 243     $S0 = concat $S0, $S2
 244     $S0 = concat $S0, ","
 245     goto loop
 246   loop_end:
 247     is($S0, "1.1,99.99,-345.001,", "get_iter works")
 248 .end
 249
 250 .sub test_new_style_init
 251     $P0 = new 'FixedFloatArray', 10
 252
 253     $I0 = $P0
 254     is($I0, 10, "New style init creates the correct # of elements")
 255
 256     $P0 = new ['FixedFloatArray'], 10
 257
 258     $I0 = $P0
 259     is($I0, 10, "New style init creates the correct # of elements for a key constant")
 260 .end
 261
 262 .sub test_invalid_init_tt1509
 263     throws_substring(<<'CODE', 'FixedFloatArray: Cannot set array size to a negative number (-10)', 'New style init does not dump core for negative array lengths')
 264     .sub main
 265         $P0 = new ['FixedFloatArray'], -10
 266     .end
 267 CODE
 268
 269     throws_substring(<<'CODE', 'FixedFloatArray: Cannot set array size to a negative number (-10)', 'New style init (key constant) does not dump core for negative array lengths')
 270     .sub main
 271         $P0 = new 'FixedFloatArray', -10
 272     .end
 273 CODE
 274 .end
 275
 276 # Local Variables:
 277 #   mode: pir
 278 #   fill-column: 100
 279 # End:
 280 # vim: expandtab shiftwidth=4 ft=pir: