compiler.cfg.*: more unit tests

basis/compiler/cfg/dataflow-analysis/dataflow-analysis-tests.factor

@@ -0,0 +1,30 @@
+USING: accessors assocs compiler.cfg.dataflow-analysis
+compiler.cfg.dataflow-analysis.private compiler.cfg.rpo compiler.cfg.utilities
+kernel tools.test ;
+IN: compiler.cfg.dataflow-analysis.tests
+
+! run-dataflow-analysis
+TUPLE: im-a-dfa test ;
+
+M: im-a-dfa block-order ( cfg dfa -- bbs )
+    drop post-order ;
+
+M: im-a-dfa ignore-block? ( cfg bb -- ? )
+    2drop f ;
+
+M: im-a-dfa predecessors ( bb dfa -- seq )
+    drop predecessors>> ;
+
+M: im-a-dfa successors ( bb dfa -- seq )
+    drop successors>> ;
+
+M: im-a-dfa join-sets ( sets bb dfa -- set )
+    2drop ;
+
+M: im-a-dfa transfer-set ( in-set bb dfa -- out-set )
+    2drop ;
+
+{ { V{ } } { V{ } } } [
+    { } 0 insns>block block>cfg 10 im-a-dfa boa run-dataflow-analysis
+    [ values ] bi@
+] unit-test

basis/compiler/cfg/def-use/def-use-tests.factor

@@ -6,6 +6,14 @@ compiler.cfg.instructions compiler.cfg.registers compiler.cfg.utilities
 cpu.architecture ;
 IN: compiler.cfg.def-use.tests
 
+! compute-insns
+{
+    T{ ##peek f 123 D 0 f }
+} [
+    { T{ ##peek f 123 D 0 } } 0 insns>block block>cfg compute-insns
+    123 insn-of
+] unit-test
+
 V{
     T{ ##peek f 0 D 0 }
     T{ ##peek f 1 D 0 }

basis/compiler/cfg/linear-scan/allocation/spilling/spilling-tests.factor

@@ -1,11 +1,11 @@
-USING: compiler.cfg.instructions compiler.cfg.linear-scan.allocation.spilling
+USING: assocs compiler.cfg compiler.cfg.instructions
-compiler.cfg.linear-scan.live-intervals cpu.architecture sequences tools.test ;
+compiler.cfg.linear-scan.allocation.spilling
+compiler.cfg.linear-scan.allocation.state
+compiler.cfg.linear-scan.live-intervals compiler.cfg.registers cpu.architecture
+kernel namespaces sequences tools.test ;
 IN: compiler.cfg.linear-scan.allocation.spilling.tests
 
-! last-use-rep
+: test-live-interval ( -- live-interval )
-{
-    double-rep
-} [
     T{ live-interval-state
        { vreg 45 }
        { spill-to T{ spill-slot { n 8 } } }
@@ -33,5 +33,18 @@ IN: compiler.cfg.linear-scan.allocation.spilling.tests
              }
          }
        }
-    } last-use-rep
+    } ;
+
+! assign-spill
+{ T{ spill-slot f 0 } } [
+    f f <basic-block> <cfg> cfg set
+    H{ } clone spill-slots set
+    H{ { 45 double-2-rep } } representations set
+    test-live-interval assign-spill
+    { 45 8 } spill-slots get at
+] unit-test
+
+! last-use-rep
+{ double-rep } [
+    test-live-interval last-use-rep
 ] unit-test

basis/compiler/cfg/linear-scan/assignment/assignment-tests.factor

@@ -1,10 +1,12 @@
 USING: accessors arrays compiler.cfg compiler.cfg.instructions
-compiler.cfg.linear-scan.assignment compiler.cfg.linear-scan.live-intervals
+compiler.cfg.linear-scan.allocation.state compiler.cfg.linear-scan.assignment
-compiler.cfg.registers compiler.cfg.ssa.destruction.leaders
+compiler.cfg.linear-scan.live-intervals compiler.cfg.registers
-compiler.cfg.utilities cpu.architecture cpu.x86.assembler.operands grouping
+compiler.cfg.ssa.destruction.leaders compiler.cfg.utilities cpu.architecture
-heaps kernel make namespaces random sequences sorting tools.test ;
+cpu.x86.assembler.operands grouping heaps kernel make namespaces random
+sequences sorting tools.test ;
 IN: compiler.cfg.linear-scan.assignment.tests
 
+! assign-insn-defs
 {
     T{ ##peek { dst RAX } { loc T{ ds-loc } } { insn# 0 } }
 } [
@@ -14,6 +16,12 @@ IN: compiler.cfg.linear-scan.assignment.tests
     T{ ##peek f 37 D 0 0 } [ assign-insn-defs ] keep
 ] unit-test
 
+! assign-registers
+{ } [
+    V{ T{ ##inc { loc D 3 } { insn# 7 } } } 0 insns>block block>cfg { }
+    assign-registers
+] unit-test
+
 ! assign-registers-in-block
 {
     V{ T{ ##inc { loc T{ ds-loc { n 3 } } } { insn# 7 } } }
@@ -38,6 +46,26 @@ IN: compiler.cfg.linear-scan.assignment.tests
     ] V{ } make
 ] unit-test
 
+! vreg>reg
+{ T{ spill-slot f 16 } } [
+    H{ { 45 double-2-rep } } representations set
+    H{ { 45 45 } } leader-map set
+    H{ { { 45 16 } T{ spill-slot { n 16 } } } } spill-slots set
+    45 vreg>reg
+] unit-test
+
+[
+    ! It gets very strange if the leader of a vreg has a different
+    ! sized representation than the vreg being led.
+    H{
+        { 45 double-2-rep }
+        { 46 double-rep }
+    } representations set
+    H{ { 45 45 } { 46 45 } } leader-map set
+    H{ { { 45 16 } T{ spill-slot { n 16 } } } } spill-slots set
+    46 vreg>reg
+] [ bad-vreg? ] must-fail-with
+
 { { 3 56 } } [
     { { 3 7 } { -1 56 } { -1 3 } } >min-heap [ -1 = ] heap-pop-while
     natural-sort
@@ -48,8 +76,3 @@ IN: compiler.cfg.linear-scan.assignment.tests
     pending-interval-heap set 90 expire-old-intervals
     pending-interval-heap get heap-size
 ] unit-test
-
-{ } [
-    V{ T{ ##inc { loc D 3 } { insn# 7 } } } 0 insns>block block>cfg { }
-    assign-registers
-] unit-test