t/pmc/testlib/packfile_common.pir

   1 #! parrot
   2 # Copyright (C) 2009, Parrot Foundation.
   3 # $Id$
   4
   5 # Common functions for various Packfile* PMCs tests.
   6 # Return test filename
   7 # Currently parrot doesn't support system independent PBCs. So, cross your
   8 # fingers and try different filename for binary-dependent tests...
   9
  10 .sub '_filename'
  11     .local string filename
  12     filename = 't/pmc/testlib/number.pbc'
  13     .return (filename)
  14 .end
  15
  16 # common pbc loading function
  17 .sub '_pbc'
  18     .include "stat.pasm"
  19     .include "interpinfo.pasm"
  20     .local pmc pf, pio
  21     pf   = new ['Packfile']
  22     $S0  = '_filename'()
  23     pio  = new ['FileHandle']
  24     pio.'open'($S0, 'r')
  25     $S0  = pio.'readall'()
  26     pio.'close'()
  27     pf   = $S0
  28     .return(pf)
  29 .end
  30
  31 .sub '_find_segment_by_type'
  32     .param pmc pf
  33     .param string type
  34     .local pmc pfdir, it
  35
  36     pfdir = pf.'get_directory'()
  37     it = iter pfdir
  38   loop:
  39     unless it goto done
  40     $S0 = shift it
  41     $P0 = pfdir[$S0]
  42     $I0 = isa $P0, type
  43     unless $I0 goto loop
  44     .return ($P0)
  45   done:
  46     .return ()
  47 .end
  48
  49 .sub '_find_segment_by_prefix'
  50     .param pmc pf
  51     .param string prefix
  52     .local pmc pfdir, it
  53
  54     pfdir = pf.'get_directory'()
  55     it = iter pfdir
  56   loop:
  57     unless it goto done
  58     $S0 = shift it
  59     $I0 = index $S0, prefix
  60     if $I0 != 0 goto loop
  61     $P0 = pfdir[$S0]
  62     .return ($P0)
  63   done:
  64     .return ()
  65 .end
  66
  67 .sub '_get_fixup_table'
  68     .param pmc pf
  69
  70     .tailcall '_find_segment_by_type'(pf, "PackfileFixupTable")
  71 .end
  72
  73
  74 # Report no ok for loading packfile failures
  75 .sub report_load_error
  76     .param pmc except
  77     .param string desc
  78     .local string msg, aux
  79     msg = concat desc, ' - error loading packfile: '
  80     aux = except['message']
  81     msg = concat msg, aux
  82     ok(0, msg)
  83 .end
  84
  85
  86 # Local Variables:
  87 #   mode: pir
  88 #   fill-column: 100
  89 # End:
  90 # vim: expandtab shiftwidth=4 ft=pir: