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

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