extra/tools/gc-decode/gc-decode-tests.factor

   1 USING: bit-arrays classes.struct math sequences tools.gc-decode
   2 tools.test vm ;
   3 QUALIFIED: effects
   4 QUALIFIED: llvm.types
   5 IN: tools.gc-decode.tests
   6
   7 ! byte-array>bit-array
   8 {
   9     ?{
  10         t t t t f t t t
  11         t f f f f f f f
  12     }
  13 } [
  14     B{ 239 1 } byte-array>bit-array
  15 ] unit-test
  16
  17 { ?{ t t t t t t t t } } [ B{ 255 } byte-array>bit-array ] unit-test
  18
  19 ! scrub-bits
  20 { t } [
  21     \ effects:<effect> word>gc-info scrub-bits
  22     {
  23         ?{ t t t f t t t t } ! 64-bit
  24         ?{ t t t f f f f f t t t t } ! 32-bit
  25     } member?
  26 ] unit-test
  27
  28 {
  29     { }
  30 } [
  31     \ decode-gc-maps word>gc-info scrub-bits
  32 ] unit-test
  33
  34 ! decode-gc-maps
  35 { f } [
  36     \ effects:<effect> decode-gc-maps empty?
  37 ] unit-test
  38
  39 { f } [
  40     \ + decode-gc-maps empty?
  41 ] unit-test
  42
  43 ! read-gc-maps
  44 { { } } [
  45     \ decode-gc-maps decode-gc-maps
  46 ] unit-test
  47
  48 ! base-pointer-groups
  49 { t } [
  50     \ llvm.types:resolve-types word>gc-info base-pointer-groups
  51     {
  52         {
  53             { -1 -1 -1 -1 -1 -1 -1 }
  54             { -1 -1 -1 -1 -1 -1 -1 }
  55             { -1 -1 -1 -1 -1 -1 -1 }
  56             { -1 -1 -1 -1 -1 -1 4 }
  57             { -1 -1 -1 -1 -1 -1 4 }
  58             { -1 -1 -1 -1 -1 -1 -1 }
  59         } ! 64-bit
  60         {
  61             { -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 }
  62             { -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 }
  63             { -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 }
  64             { -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 8 }
  65             { -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 8 }
  66             { -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 }
  67         } ! 32-bit
  68     } member?
  69 ] unit-test
  70
  71
  72 ! One of the few words that has derived roots.
  73 { t } [
  74     \ llvm.types:resolve-types word>gc-info
  75     {
  76         S{ gc-info f 0 2 2 1 5 8 6 } ! 64-bit
  77         S{ gc-info f 0 2 2 1 9 12 6 } ! 32-bit
  78     } member?
  79 ] unit-test