compiler.cfg.*: some extra unit tests for the compiler

basis/compiler/cfg/block-joining/block-joining-tests.factor

@@ -0,0 +1,11 @@
+USING: accessors compiler.cfg.block-joining compiler.cfg.utilities
+kernel tools.test ;
+IN: compiler.cfg.block-joining.tests
+
+{
+    V{ "hello" "there" "B" }
+} [
+    { "there" "B" } 0 insns>block
+    { "hello" "B" } 1 insns>block
+    [ join-instructions ] keep instructions>>
+] unit-test

basis/compiler/cfg/gc-checks/gc-checks-tests.factor

@@ -8,10 +8,9 @@ compiler.cfg.comparisons compiler.test compiler.cfg.utilities ;
 IN: compiler.cfg.gc-checks.tests
 
 ! insert-gc-check?
-{ t } [
-    V{
-        T{ ##inc } T{ ##allot }
-    } 0 insns>block insert-gc-check?
+{ t f } [
+    V{ T{ ##inc } T{ ##allot } } 0 insns>block insert-gc-check?
+    V{ T{ ##call } } 0 insns>block insert-gc-check?
 ] unit-test
 
 ! allocation-size

basis/compiler/cfg/hats/hats-tests.factor

@@ -0,0 +1,9 @@
+USING: compiler.cfg.hats compiler.cfg.instructions
+compiler.cfg.registers make tools.test ;
+IN: compiler.cfg.hats.tests
+
+{
+    1 V{ T{ ##local-allot { dst 1 } { size 32 } { align 8 } } }
+} [
+    reset-vreg-counter [ 32 8 f ^^local-allot ] V{ } make
+] unit-test

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

@@ -107,7 +107,7 @@ ${
 
 ! align-spill-area
 { t } [
-    3 f f { } 0 insns>block <cfg> [ align-spill-area ] keep
+    3 { } insns>cfg [ align-spill-area ] keep
     spill-area-align>> cell =
 ] unit-test
 

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

@@ -31,6 +31,19 @@ IN: compiler.cfg.linear-scan.assignment.tests
     [ assign-registers-in-block ] keep instructions>>
 ] unit-test
 
+! insert-reload
+{
+    { T{ ##reload { dst RAX } { rep int-rep } { src T{ spill-slot } } } }
+} [
+    [
+        T{ live-interval-state
+           { reg RAX }
+           { reload-from T{ spill-slot } }
+           { reload-rep int-rep }
+        } insert-reload
+    ] { } make
+] unit-test
+
 ! insert-spill
 { { T{ ##spill { src RAX } } } } [
     [

basis/compiler/cfg/liveness/liveness-tests.factor

@@ -1,9 +1,9 @@
-USING: accessors compiler.cfg.liveness
-compiler.cfg compiler.cfg.debugger compiler.cfg.instructions
-compiler.cfg.predecessors compiler.cfg.registers
+USING: accessors alien assocs compiler.cfg.comparisons compiler.cfg.liveness
+compiler.cfg compiler.cfg.debugger compiler.cfg.def-use
+compiler.cfg.instructions compiler.cfg.predecessors compiler.cfg.registers
 compiler.cfg.ssa.destruction.leaders compiler.cfg.utilities cpu.architecture
-dlists namespaces sequences kernel tools.test vectors alien math
-compiler.cfg.comparisons cpu.x86.assembler.operands assocs ;
+cpu.x86.assembler.operands dlists math namespaces sequences kernel system
+tools.test vectors ;
 IN: compiler.cfg.liveness.tests
 QUALIFIED: sets
 
@@ -101,6 +101,14 @@ QUALIFIED: sets
     30 lookup-base-pointer
 ] unit-test
 
+cpu x86.64? [
+    { f } [
+        H{ } base-pointers set
+        H{ { 123 T{ ##peek { dst RCX } { loc D 1 } { insn# 6 } } } } insns set
+        123 lookup-base-pointer
+    ] unit-test
+] when
+
 ! lookup-base-pointer*
 { f } [
     456 T{ ##peek f 123 D 0 } lookup-base-pointer*

basis/compiler/cfg/ssa/destruction/destruction-tests.factor

@@ -5,21 +5,31 @@ cpu.architecture cpu.x86.assembler.operands kernel make namespaces
 sequences tools.test ;
 IN: compiler.cfg.ssa.destruction.tests
 
-! cleanup-insn
-{
-    V{ T{ ##copy { src 45 } { dst 47 } { rep double-2-rep } } }
-} [
+: setup-leader/reps-scenario ( -- )
+    ! Note the differences in representation.
     H{ { 45 45 } { 46 45 } { 47 47 } { 100 47 } } leader-map set
-    ! how can the leader of a vreg have a different representation
-    ! than the vreg itself?
     H{
         { 45 double-2-rep }
         { 46 double-rep }
         { 47 double-rep }
         { 100 double-rep }
-    } representations set
-    T{ ##parallel-copy { values V{ { 100 46 } } } }
-    [ cleanup-insn ] V{ } make
+    } representations set ;
+
+! cleanup-insn
+{
+    V{ T{ ##copy { dst 100 } { src 46 } } }
+} [
+    setup-leader/reps-scenario
+    T{ ##copy { src 46 } { dst 100 } } [ cleanup-insn ] V{ } make
+] unit-test
+
+! I think the difference is because ##parallel-copy may encode a swap
+! between two vregs.
+{
+    V{ T{ ##copy { dst 47 } { src 45 } { rep double-2-rep } } }
+} [
+    setup-leader/reps-scenario
+    T{ ##parallel-copy { values V{ { 100 46 } } } } [ cleanup-insn ] V{ } make
 ] unit-test
 
 { V{ } } [