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

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