From 4ae66793f028ad54beb524476a7d403e07a5cd3f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 19 Oct 2008 03:51:01 -0500
Subject: [PATCH] Fixing unit tests

---
 basis/compiler/tests/templates.factor | 51 ++++++++++++++++++++++-----
 1 file changed, 42 insertions(+), 9 deletions(-)

diff --git a/basis/compiler/tests/templates.factor b/basis/compiler/tests/templates.factor
index a979a19e83..6bcbb8baea 100644
--- a/basis/compiler/tests/templates.factor
+++ b/basis/compiler/tests/templates.factor
@@ -1,11 +1,15 @@
-! Black box testing of templating optimization
-USING: accessors arrays compiler kernel kernel.private math
-hashtables.private math.private namespaces sequences
-sequences.private tools.test namespaces.private slots.private
-sequences.private byte-arrays alien alien.accessors layouts
-words definitions compiler.units io combinators vectors ;
+USING: generalizations accessors arrays compiler kernel
+kernel.private math hashtables.private math.private namespaces
+sequences sequences.private tools.test namespaces.private
+slots.private sequences.private byte-arrays alien
+alien.accessors layouts words definitions compiler.units io
+combinators vectors ;
 IN: compiler.tests
 
+! Originally, this file did black box testing of templating
+! optimization. We now have a different codegen, but the tests
+! in here are still useful.
+
 ! Oops!
 [ 5000 ] [ [ 5000 ] compile-call ] unit-test
 [ "hi" ] [ [ "hi" ] compile-call ] unit-test
@@ -102,7 +106,7 @@ unit-test
 ] unit-test
 
 ! Test how dispatch handles the end of a basic block
-: try-breaking-dispatch ( n a b -- a b str )
+: try-breaking-dispatch ( n a b -- x str )
     float+ swap { [ "hey" ] [ "bye" ] } dispatch ;
 
 : try-breaking-dispatch-2 ( -- ? )
@@ -121,7 +125,7 @@ unit-test
 ] unit-test
 
 ! Regression
-: hellish-bug-1 2drop ;
+: hellish-bug-1 ( a b -- ) 2drop ;
 
 : hellish-bug-2 ( i array x -- x ) 
     2dup 1 slot eq? [ 2drop ] [ 
@@ -131,7 +135,7 @@ unit-test
                 pick 2dup hellish-bug-1 3drop
             ] 2keep
         ] unless >r 2 fixnum+fast r> hellish-bug-2
-    ] if ; inline
+    ] if ; inline recursive
 
 : hellish-bug-3 ( hash array -- ) 
     0 swap hellish-bug-2 drop ;
@@ -334,6 +338,35 @@ TUPLE: my-tuple ;
 
 [ t ] [ \ float-fixnum-spill-bug compiled>> ] unit-test
 
+: resolve-spill-bug ( a b -- c )
+    [ 1 fixnum+fast ] bi@ dup 10 fixnum< [
+        nip 2 fixnum+fast
+    ] [
+        drop {
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+        } cleave
+        16 narray
+    ] if ;
+
+[ t ] [ \ resolve-spill-bug compiled>> ] unit-test
+
+[ 4 ] [ 1 1 resolve-spill-bug ] unit-test
+
 ! Regression
 : dispatch-alignment-regression ( -- c )
     { tuple vector } 3 slot { word } declare