basis/stack-checker/backend/backend-tests.factor

   1 USING: accessors classes.tuple compiler.tree stack-checker.backend tools.test
   2 kernel namespaces stack-checker.state stack-checker.values
   3 stack-checker.visitor sequences assocs ;
   4 IN: stack-checker.backend.tests
   5
   6 [ ] [
   7     V{ } clone (meta-d) set
   8     V{ } clone (meta-r) set
   9     V{ } clone literals set
  10     H{ } clone known-values set
  11     0 input-count set
  12     0 inner-d-index set
  13 ] unit-test
  14
  15 [ 0 ] [ 0 ensure-d length ] unit-test
  16
  17 [ 2 ] [ 2 ensure-d length ] unit-test
  18
  19 [ t ] [ meta-d [ known-values get at input-parameter? ] all? ] unit-test
  20
  21 [ 2 ] [ meta-d length ] unit-test
  22
  23 [ 3 ] [ 3 ensure-d length ] unit-test
  24 [ 3 ] [ meta-d length ] unit-test
  25
  26 [ 1 ] [ 1 ensure-d length ] unit-test
  27 [ 3 ] [ meta-d length ] unit-test
  28
  29 { } [ 1 consume-d drop ] unit-test
  30
  31 {
  32     V{ 3 9 8 }
  33     H{ { 8 input-parameter } { 9 input-parameter } { 3 input-parameter } }
  34 } [
  35     init-known-values
  36     V{ } clone stack-visitor set
  37     V{ 3 9 8 } introduce-values
  38     stack-visitor get first out-d>>
  39     known-values get
  40 ] unit-test
  41
  42 { V{ 1 2 3 4 5 } } [
  43     0 \ <value> set-global init-inference 5 ensure-d
  44 ] unit-test
  45
  46 { V{ 9 7 3 } } [
  47     V{ } clone stack-visitor set
  48     V{ 9 7 3 } (meta-d) set
  49     end-infer
  50     stack-visitor get first in-d>>
  51 ] unit-test
  52
  53 ! Because node is an identity-tuple
  54 : node-seqs-eq? ( seq1 seq2 -- ? )
  55     [ [ tuple-slots ] map concat ] bi@ = ;
  56
  57 ! pop-d
  58 { t } [
  59     0 \ <value> set-global [
  60         V{ } clone stack-visitor set pop-d
  61     ] with-infer 2nip
  62     V{ T{ #introduce { out-d { 1 } } } T{ #return { in-d V{ } } } }
  63     node-seqs-eq?
  64 ] unit-test
  65
  66 : foo ( x -- )
  67     drop ;
  68
  69 { t } [
  70     0 \ <value> set-global [
  71         V{ } clone stack-visitor set
  72         [ foo ] <literal> infer-literal-quot
  73     ] with-infer nip
  74     V{
  75         T{ #introduce { out-d { 1 } } }
  76         T{ #call { word foo } { in-d V{ 1 } } { out-d { } } }
  77         T{ #return { in-d V{ } } }
  78     } node-seqs-eq?
  79 ] unit-test