t/pmc/capture.t

   1 #!./parrot
   2 # Copyright (C) 2001-2010, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/pmc/capture.t - Test the Capture PMC
   8
   9 =head1 SYNOPSIS
  10
  11     % parrot t/pmc/capture.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests the C<Capture> PMC. Checks integer and key access using
  16 a variety of keys and values.
  17
  18 =cut
  19
  20 .const int TESTS = 53
  21
  22 .sub 'test' :main
  23     .include 'test_more.pir'
  24
  25     plan(TESTS)
  26
  27     test_new_capture()
  28     empty_capture_tests()
  29     basic_capture_tests()
  30     test_defined_delete_exists()
  31     test_hash_list()
  32     test_get_integer()
  33     test_get_number()
  34     test_keyed_int_delegation()
  35     test_list_delegation()
  36 .end
  37
  38 .sub 'test_new_capture'
  39     .local pmc capt
  40
  41     capt = new ['Capture']
  42     ok(1, 'new Capture')
  43 .end
  44
  45 .sub 'empty_capture_tests'
  46     .local pmc capt
  47
  48     capt = new ['Capture']
  49
  50     $I0 = elements capt
  51     is($I0, 0, 'elements on empty Capture')
  52
  53     $N0 = capt[0]
  54     is($N0, 0.0, 'get_number_keyed_int on empty Capture')
  55     $I0 = capt[0]
  56     is($I0, 0, 'get_integer_keyed_int on empty Capture')
  57     $S0 = capt[0]
  58     is($S0, '', 'get_string_keyed_int on empty Capture')
  59
  60     $N0 = capt['nothing']
  61     is($N0, 0.0, 'get_number_keyed on empty Capture')
  62
  63     $S0 = capt
  64     $S1 = 'get_string on empty Capture - ' . $S0
  65     substring($S0, 'Capture[', $S1)
  66 .end
  67
  68 .sub 'basic_capture_tests'
  69     .local pmc capt
  70
  71     capt = new ['Capture']
  72
  73     capt[0] = 0
  74     capt[1] = 1.5
  75     capt[2] = 'two'
  76     $P0 = new ['Integer']
  77     $P0 = 3
  78     capt[3] = $P0
  79
  80     push capt, 4
  81     push capt, 5.5
  82     push capt, 'six'
  83     $P0 = new ['Integer']
  84     $P0 = 7
  85     push capt, $P0
  86
  87     unshift capt, 8
  88     unshift capt, 9.5
  89     unshift capt, 'ten'
  90     $P0 = new ['Integer']
  91     $P0 = 11
  92     unshift capt, $P0
  93
  94     capt['alpha'] = 12
  95     capt['beta'] = 13.5
  96     capt['gamma'] = 'fourteen'
  97     $P0 = new ['Integer']
  98     $P0 = 15
  99     capt['delta'] = $P0
 100
 101     $I0 = elements capt
 102     is($I0, 12, 'elements')
 103
 104     $I0 = capt[11]
 105     is($I0, 7, 'get_integer_keyed_int')
 106
 107     $P0 = capt[10]
 108     is($P0, 'six', 'get_pmc_keyed_int')
 109
 110     $N0 = capt[9]
 111     is($N0, 5.5, 'get_number_keyed_int')
 112
 113     $S0 = capt[8]
 114     is($S0, '4', 'get_string_keyed_int')
 115
 116     $I0 = pop capt
 117     is($I0, 7, 'pop an integer')
 118
 119     $P0 = pop capt
 120     is($P0, 'six', 'pop a PMC')
 121
 122     $N0 = pop capt
 123     is($N0, 5.5, 'pop a number')
 124
 125     $S0 = pop capt
 126     is($S0, '4', 'pop a string')
 127
 128     $I0 = elements capt
 129     is($I0, 8, 'elements after pop')
 130
 131     $I0 = shift capt
 132     is($I0, 11, 'shift an integer')
 133
 134     $P0 = shift capt
 135     is($P0, 'ten', 'shift a PMC')
 136
 137     $N0 = shift capt
 138     is($N0, 9.5, 'shift a number')
 139
 140     $S0 = shift capt
 141     is($S0, '8', 'shift a string')
 142
 143     $I0 = elements capt
 144     is($I0, 4, 'elements after shift')
 145
 146     $P0 = pop capt
 147     is($P0, 3, 'pop 1 out of 4')
 148
 149     $P0 = pop capt
 150     is($P0, 'two', 'pop 2 out of 4')
 151
 152     $P0 = pop capt
 153     is($P0, 1.5, 'pop 3 out of 4')
 154
 155     $P0 = pop capt
 156     is($P0, 0, 'pop 4 out of 4')
 157
 158     $I0 = capt['delta']
 159     is($I0, 15, 'get_integer_keyed_str')
 160
 161     $P0 = capt['gamma']
 162     is($P0, 'fourteen', 'get_pmc_keyed_str')
 163
 164     $N0 = capt['beta']
 165     is($N0, 13.5, 'get_number_keyed_str')
 166
 167     $S0 = capt['alpha']
 168     is($S0, '12', 'get_string_keyed_str')
 169 .end
 170
 171 .sub 'test_defined_delete_exists'
 172     .local pmc capt
 173     capt = new ['Capture']
 174
 175     $I0 = defined capt[2]
 176     nok($I0, 'defined_i initially false')
 177
 178     $I1 = exists capt[2]
 179     nok($I1, 'exists_i initially false')
 180
 181     $I0 = defined capt['alpha']
 182     nok($I0, 'defined_s initially false')
 183
 184     $I1 = exists capt['alpha']
 185     nok($I1, 'exists_s initially false')
 186
 187     capt[2] = 1
 188     capt['alpha'] = 1
 189     $P0 = new ['Undef']
 190     capt['beta'] = $P0
 191
 192     $I0 = defined capt[2]
 193     ok($I0, 'defined_i true after set')
 194
 195     $I1 = exists capt[2]
 196     ok($I1, 'exists_i true after set')
 197
 198     $I0 = defined capt['alpha']
 199     ok($I0, 'defined_s true after set')
 200
 201     $I1 = exists capt['alpha']
 202     ok($I1, 'exists_s true after set')
 203
 204     $I0 = defined capt[1]
 205     nok($I0, 'defined_i - no intermediate element created')
 206
 207     $I1 = exists capt[1]
 208     nok($I1, 'exists_i - no intermediate element created')
 209
 210     $I0 = defined capt['beta']
 211     nok($I0, 'defined_s checks for Undef values...')
 212
 213     $I1 = exists capt['beta']
 214     ok($I1, 'but exists_s does not care')
 215
 216     delete capt[2]
 217     delete capt['alpha']
 218
 219     $I0 = defined capt[2]
 220     nok($I0, 'defined_i false after delete')
 221     $I1 = exists capt[2]
 222     nok($I1, 'exists_i false after delete')
 223
 224     $I0 = defined capt['alpha']
 225     nok($I0, 'defined_s false after delete')
 226     $I1 = exists capt['alpha']
 227     nok($I1, 'exists_s false after delete')
 228 .end
 229
 230 .sub 'test_hash_list'
 231     .local pmc capt
 232
 233     capt = new ['Capture']
 234
 235     $P0 = capt.'list'()
 236     $P1 = capt.'hash'()
 237
 238     isa_ok($P0, 'ResizablePMCArray', "capt.'list'")
 239     isa_ok($P1, 'Hash', "capt.'hash'")
 240 .end
 241
 242 .sub 'test_get_integer'
 243     .local pmc capt
 244
 245     capt = new ['Capture']
 246     push_eh test_get_integer_catch
 247     $I0 = capt
 248
 249     nok(1, 'get_integer not implemented')
 250     .return ()
 251
 252   test_get_integer_catch:
 253     pop_eh
 254     .local pmc exception
 255     .local string message
 256     .get_results (exception)
 257
 258     message = exception['message']
 259     message = substr message, 0, 29
 260     is(message, 'get_integer() not implemented', 'get_integer not implemented')
 261     .return ()
 262 .end
 263
 264 .sub 'test_get_number'
 265     .local pmc capt
 266
 267     capt = new ['Capture']
 268     push_eh test_get_number_catch
 269     $N0 = capt
 270
 271     nok(1, 'get_number not implemented')
 272     .return ()
 273
 274   test_get_number_catch:
 275     .local pmc exception
 276     .local string message
 277     .get_results (exception)
 278
 279     message = exception['message']
 280     message = substr message, 0, 28
 281     is(message, 'get_number() not implemented', 'get_number not implemented')
 282     .return ()
 283 .end
 284
 285
 286 .sub 'test_keyed_int_delegation'
 287     $P99 = subclass ['Capture'], ['Match']
 288     $P1 = new ['Match']
 289     $P1[1] = 1
 290     $I1 = elements $P1
 291     is($I1, 2, 'elements - delegated to parent class')
 292
 293     $P99 = subclass ['Match'], ['Exp']
 294     $P2 = new ['Exp']
 295     $P2[1] = 1
 296     $I2 = elements $P2
 297     is($I2, 2, 'elements - delegated twice')
 298 .end
 299
 300 .sub 'test_list_delegation'
 301     $P0 = subclass ['Capture'], ['Match2']
 302     addattribute $P0, '$.abc'
 303     addattribute $P0, '$.xyz'
 304     $P1 = new ['Match2']
 305     $P1[1] = 1
 306
 307     $P2 = new ['String']
 308     setattribute $P1, '$.abc', $P2
 309     $P2 = new ['String']
 310     setattribute $P1, '$.xyz', $P2
 311
 312     $P2 = $P1.'list'()
 313     $P2 = 0
 314     $I0 = elements $P2
 315     is($I0, 0, 'list method delegation')
 316 .end
 317
 318 # Local Variables:
 319 #   mode: pir
 320 #   fill-column: 100
 321 # End:
 322 # vim: expandtab shiftwidth=4 ft=pir: