t/pmc/packfile.t

   1 #!./parrot
   2 # Copyright (C) 2006-2010, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/pmc/packfile.t - test the Packfile PMC
   8
   9
  10 =head1 SYNOPSIS
  11
  12     % make test_prep
  13     % prove t/pmc/packfile.t
  14
  15 =head1 DESCRIPTION
  16
  17 Tests the Packfile PMC.
  18
  19 =cut
  20
  21 .include 't/pmc/testlib/packfile_common.pir'
  22 .include 'except_types.pasm'
  23
  24 .sub main :main
  25 .include 'test_more.pir'
  26
  27     plan(47)
  28     'test_new'()
  29     'test_set_string_native'()
  30     'test_get_string'()
  31     'test_set_string'()
  32     'test_get_integer_keyed_str'()
  33     'test_set_integer_keyed_str'()
  34     'test_get_directory'()
  35     'test_load'()
  36     'test_pack_fresh_packfile'()
  37     'test_pack'()
  38
  39     skip(2, "test_synonyms crash on many platforms. See TT #545")
  40     # 'test_synonyms'()
  41
  42 .end
  43
  44
  45 # Packfile constructor
  46 .sub 'test_new'
  47     .local pmc pf
  48     pf = new ['Packfile']
  49     $I0 = defined pf
  50     ok($I0, 'new')
  51
  52     # Make sure the mark vtable function is exercised
  53     sweep 1
  54
  55     .tailcall _check_header(pf)
  56 .end
  57
  58
  59 .sub 'test_set_string_native'
  60     .local pmc pf, eh
  61     .local int result
  62
  63     eh = new ['ExceptionHandler']
  64     eh.'handle_types'(.EXCEPTION_MALFORMED_PACKFILE)
  65     set_label eh, catch
  66     push_eh eh
  67     pf = new ['Packfile']
  68     pf = 'This is not data with a valid packfile format'
  69     result = 0
  70     goto end
  71   catch:
  72     result = 1
  73   end:
  74     pop_eh
  75     is(result, 1, 'set_string_native with invalid data throws')
  76 .end
  77
  78
  79 .sub 'test_get_string'
  80     .local pmc pf, eh
  81     pf = new ['Packfile']
  82     $S0 = pf["uuid"]
  83     ok(1, 'get_string(uuid)')
  84
  85     # Requesting unknown key should throw exception
  86     eh = new ['ExceptionHandler']
  87     eh.'handle_types'(.EXCEPTION_KEY_NOT_FOUND)
  88     set_label eh, unknown_key
  89     push_eh eh
  90     $S0 = pf["foo"]
  91     pop_eh
  92     ok(0, "get_string_keyed_int return unknown key")
  93     .return ()
  94
  95   unknown_key:
  96     pop_eh
  97     ok(1, "get_string_keyed_int handle unknown key properly")
  98     .return ()
  99 .end
 100
 101 .sub 'test_set_string'
 102     .local pmc pf
 103     pf = new ['Packfile']
 104     pf["uuid"] = "fe9ab64082e0f6bbbd7b1e8264127908"
 105     ok(1, 'set_string(uuid)')
 106
 107     # Special check for 0
 108     $S0 = "\0"
 109     $I0 = length $S0
 110     is($I0, 1, "Length is 1")
 111     pf["uuid"] = $S0
 112     $S1 = pf["uuid"]
 113     $I1 = length $S1
 114     is($I1, 1, "Fetched length is 1")
 115
 116     # Requesting unknown key should throw exception
 117     push_eh unknown_key
 118     pf["foo"] = "fe9ab64082e0f6bbbd7b1e8264127908"
 119     pop_eh
 120     ok(0, "set_string_keyed_int set unknown key")
 121     .return ()
 122
 123   unknown_key:
 124     pop_eh
 125     ok(1, "set_string_keyed_int handle unknown key properly")
 126     .return ()
 127 .end
 128
 129 # Compose the message for the given key
 130 .sub 'keyed_str_msg'
 131     .param string key
 132     .local string msg
 133     msg = 'get_integer_keyed_str('
 134     msg = concat msg, key
 135     msg = concat msg, ')'
 136     .return(msg)
 137 .end
 138 .sub 'set_keyed_str_msg'
 139     .param string key
 140     .local string msg
 141     msg = 'set_integer_keyed_str('
 142     msg = concat msg, key
 143     msg = concat msg, ')'
 144     .return(msg)
 145 .end
 146
 147 # Check the given key in the Packfile pf
 148 .sub 'do_get_integer_keyed_str'
 149     .param pmc pf
 150     .param string key
 151     .local string msg
 152     .local int result
 153     msg = 'keyed_str_msg'(key)
 154     result = 0
 155     push_eh fail
 156
 157     $I0 = pf[key]
 158     result = 1
 159     goto end
 160   fail:
 161     .get_results($P0)
 162     pop_eh
 163   end:
 164     ok(result, msg)
 165 .end
 166
 167 # Create a list of the keys for the integer attributes
 168 .sub 'integer_keys'
 169     .local pmc keys
 170     keys = new ['ResizableStringArray']
 171     push keys, 'wordsize'
 172     push keys, 'byteorder'
 173     push keys, 'fptype'
 174     push keys, 'version_major'
 175     push keys, 'version_minor'
 176     push keys, 'version_patch'
 177     push keys, 'bytecode_major'
 178     push keys, 'bytecode_minor'
 179     push keys, 'uuid_type'
 180     .return(keys)
 181 .end
 182
 183 # Some keys are still not handled in set_integer_keyed_str
 184 # Use this list for its test
 185 .sub 'integer_keys_s'
 186     .local pmc keys
 187     keys = new ['ResizableStringArray']
 188     push keys, 'version_major'
 189     push keys, 'version_minor'
 190     push keys, 'version_patch'
 191     push keys, 'uuid_type'
 192     .return(keys)
 193 .end
 194
 195
 196 .sub 'test_get_integer_keyed_str'
 197     .local pmc pf, keys
 198     .local int nkeys, i
 199
 200     keys = 'integer_keys'()
 201     nkeys = elements keys
 202
 203     push_eh load_error
 204     pf  = _pbc()
 205     pop_eh
 206
 207     i = 0
 208   nextkey:
 209     $S0 = keys[i]
 210     do_get_integer_keyed_str(pf, $S0)
 211     inc i
 212     if i < nkeys goto nextkey
 213
 214     # Requesting unknown key should throw exception
 215     push_eh unknown_key
 216     $I3 = pf["foo"]
 217     ok(0, "get_integer_keyed_str return unknown key")
 218     .return ()
 219
 220   unknown_key:
 221     pop_eh
 222     ok(1, "get_integer_keyed_str handle unknown key properly")
 223     .return ()
 224
 225     # On load error report a failure for each test
 226 load_error:
 227     .get_results($P0)
 228     pop_eh
 229
 230     i = 0
 231   nexterr:
 232     $S0 = keys[i]
 233     $S0 = keyed_str_msg($S0)
 234     report_load_error($P0, $S0)
 235     inc i
 236     if i < nkeys goto nexterr
 237
 238     report_load_error($P0, "get_integer_keyed_str unknown key")
 239     .return()
 240 .end
 241
 242
 243 .sub 'test_set_integer_keyed_str'
 244     .local pmc pf, keys, saved
 245     .local int nkeys, i, value, check
 246     .local string skey, msg
 247     keys = 'integer_keys_s'()
 248     nkeys = elements keys
 249     pf = new ['Packfile']
 250     saved = new ['FixedIntegerArray'], nkeys
 251
 252     # For each key get its value, set it modified and save the new value
 253     # The modified value may be invalid, but we are not going to pack it,
 254     # so it shouldn't fail here.
 255     i = 0
 256   set_next:
 257     skey = keys[i]
 258     value = pf[skey]
 259     inc value
 260     pf[skey] = value
 261     saved[i] = value
 262     inc i
 263     if i < nkeys goto set_next
 264
 265     # Read new values and compare with the saved ones
 266     i = 0
 267   get_next:
 268     skey = keys[i]
 269     value = pf[skey]
 270     check = saved[i]
 271     msg = 'set_keyed_str_msg'(skey)
 272     is(value, check, msg)
 273     inc i
 274     if i < nkeys goto get_next
 275
 276     i = 0
 277     push_eh unknown_key
 278     pf["foo"] = value
 279     goto done
 280   unknown_key:
 281     i = 1
 282   done:
 283     pop_eh
 284     is(i, 1, "set_integer_keyed_str handle unknown key properly")
 285     .return()
 286 .end
 287
 288
 289 # Packfile.get_directory
 290 .sub 'test_get_directory'
 291     .local pmc pf
 292     pf = new ['Packfile']
 293     $P0 = pf.'get_directory'()
 294     isa_ok($P0, 'PackfileDirectory')
 295 .end
 296
 297
 298 # PackfileSegment.pack (via subclass PackfileDirectory)
 299 .sub 'test_get_directory'
 300     .local pmc pf, pfdir
 301     push_eh load_error
 302     pf    = _pbc()
 303     pop_eh
 304     pfdir = pf.'get_directory'()
 305     $S0   = pfdir.'pack'()
 306     $I0   = length $S0
 307     $I1 = cmp $I0, 0
 308     ok($I1, 'get_directory')
 309     .return()
 310 load_error:
 311     .get_results($P0)
 312     pop_eh
 313     report_load_error($P0, 'get_directory')
 314     .return()
 315 .end
 316
 317
 318 # Packfile.set_string_native
 319 # Check that packfile was loaded properly and set various attributes
 320 .sub 'test_load'
 321     .local pmc pf
 322     push_eh load_error
 323     pf = _pbc()
 324     pop_eh
 325
 326     .tailcall _check_header(pf)
 327 load_error:
 328     .get_results($P0)
 329     pop_eh
 330     report_load_error($P0, "Wordsize set")
 331     report_load_error($P0, "version_major set")
 332     report_load_error($P0, "bytecode_major set")
 333     .return()
 334 .end
 335
 336 # Helper sub to check fields in Packfile header
 337 .sub '_check_header'
 338     .param pmc pf
 339
 340     # wordsize always greater than 0
 341     $I0 = pf["wordsize"]
 342     ok($I0, "Wordsize set")
 343
 344     # We are living in post-1.0 era.
 345     $I0 = pf["version_major"]
 346     ok($I0, "version_major set")
 347
 348     $I0 = pf["bytecode_major"]
 349     ok($I0, "bytecode_major set")
 350 .end
 351
 352 # Create very simple Packfile and pack it
 353 .sub 'test_pack_fresh_packfile'
 354     .local pmc pf, pfdir
 355     pf = new 'Packfile'
 356     pfdir = pf.'get_directory'()
 357     #$P0 = new 'PackfileConstantTable'
 358     #$P0[0] = 42.0
 359     $P0 = new 'PackfileFixupTable'
 360     $P1 = new 'PackfileFixupEntry'
 361     $P1 = 42
 362     $P1.'set_type'(1)
 363     $P1 = "The fixup"
 364     $P0[0] = $P1
 365     pfdir["FIXUP_t/pmc/packfile.t"] = $P0
 366
 367     $P1 = new 'PackfileRawSegment'
 368     pfdir["BYTECODE_t/pmc/packfile.t"] = $P1
 369
 370     $P2 = new 'PackfileConstantTable'
 371     $P2[0] = 42.0
 372     $P2[1] = "42"
 373     $P3 = new 'Integer'
 374     $P3 = 42
 375     $P2[2] = $P3
 376     $P4 = new 'Key'
 377     $P4 = 42
 378     $P2[3] = $P4
 379     pfdir["CONSTANTS_t/pmc/packfile.t"] = $P2
 380
 381     # Set uuid_type
 382     pf['uuid_type'] = 1
 383     $S0 = pf
 384
 385     # Pack it
 386     ok(1, "PackFile packed")
 387
 388     #$P1 = open "/tmp/1.pbc", "w"
 389     #$P1.'puts'($S0)
 390     #close $P1
 391
 392     pf = new 'Packfile'
 393     pf = $S0
 394     ok(1, "PackFile unpacked after pack")
 395
 396     $I0 = pf['uuid_type']
 397     is($I0, 1, "uuid_type preserved")
 398
 399     # Check that FixupTable contains our Entry.
 400     $P0 = _get_fixup_table(pf)
 401     $I1 = elements $P0
 402     is($I1, 1, "FixupTable contains one element")
 403     $P1 = $P0[0]
 404     isa_ok($P1, "PackfileFixupEntry")
 405     $I0 = $P1
 406     is($I0, 42, "FixupEntry offset preserved")
 407     $S0 = $P1
 408     is($S0, "The fixup", "FixupEntry name preserved")
 409
 410     # Check unpacked ConstTable
 411     $P0 = _find_segment_by_type(pf, "PackfileConstantTable")
 412     $I0 = defined $P0
 413     ok($I0, "ConstantTable unpacked")
 414     $I0 = elements $P0
 415     is($I0, 4, "    and contains 4 elements")
 416     $N0 = $P0[0]
 417     is($N0, 42.0, "    first is number")
 418     $S0 = $P0[1]
 419     is($S0, "42", "    second is string")
 420     $P1 = $P0[2]
 421     isa_ok($P1, "Integer")
 422     $I0 = $P1
 423     is($I0, 42, "    with proper value")
 424     $P1 = $P0[3]
 425     isa_ok($P1, "Key")
 426 .end
 427
 428 # Packfile.pack.
 429 # Check that unpack-pack produce correct result.
 430 .sub 'test_pack'
 431     .local string filename, orig
 432     push_eh load_error
 433     $S0 = '_filename'()
 434     $P0 = new ['FileHandle']
 435     $P0.'open'($S0, 'r')
 436
 437     orig = $P0.'readall'()
 438
 439     .local pmc packfile
 440     packfile = new 'Packfile'
 441     packfile = orig
 442     pop_eh
 443
 444     # Loaded packfile can be from different platform/config,
 445     # packing and unpacking again to avoid that differences.
 446     .local string first, second
 447     # Pack
 448     first = packfile
 449     .local pmc packfilesecond
 450     packfilesecond = new 'Packfile'
 451     packfilesecond = first
 452     second = packfilesecond
 453
 454     is(first, second, 'pack produced same result twice: TT #1614')
 455     .return()
 456 load_error:
 457     .get_results($P0)
 458     pop_eh
 459     report_load_error($P0, 'pack produced same result twice')
 460     .return()
 461 .end
 462
 463 # Test pack/set_string unpack/get_string equivalency
 464
 465 .sub 'test_synonyms'
 466     .local pmc pf
 467     push_eh load_error
 468     pf = '_pbc'()
 469     pop_eh
 470
 471     $S0 = pf
 472     $S1 = pf.'pack'()
 473     $I0 = cmp $S0, $S1
 474     is($I0, 0, "pack and get_string are synonyms")
 475
 476     # Unpack data in two ways
 477     $P0 = new ['Packfile']
 478     $P0 = $S0
 479     $P1 = new ['Packfile']
 480     $P1.'unpack'($S0)
 481
 482     $S0 = $P0
 483     $S1 = $P1
 484     $I0 = cmp $S0, $S1
 485     is($I0, 0, "unpack and set_string are synonyms")
 486     .return()
 487 load_error:
 488     .get_results($P0)
 489     pop_eh
 490     report_load_error($P0, "pack and get_string are synonyms")
 491     report_load_error($P0, "unpack and set_string are synonyms")
 492     .return()
 493 .end
 494
 495
 496 # Local Variables:
 497 #   mode: pir
 498 #   fill-column: 100
 499 # End:
 500 # vim: expandtab shiftwidth=4 ft=pir: