From 81ea0697078fe97de88bf119aa05e60f18f2d73c Mon Sep 17 00:00:00 2001
From: Neil Brown <neil@twistedsquare.com>
Date: Mon, 3 Mar 2008 15:02:07 +0000
Subject: [PATCH] Added a dummy implementation of a new pass,
 declareSizesArray, and the tests for it

---
 backends/BackendPasses.hs     | 10 +++++
 backends/BackendPassesTest.hs | 74 ++++++++++++++++++++++++++++++++++-
 2 files changed, 83 insertions(+), 1 deletion(-)

diff --git a/backends/BackendPasses.hs b/backends/BackendPasses.hs
index d371d25..b36bbd9 100644
--- a/backends/BackendPasses.hs
+++ b/backends/BackendPasses.hs
@@ -74,3 +74,13 @@ transformWaitFor = doGeneric `extM` doAlt
            return $ A.AlternativeWait m A.WaitUntil (A.ExprVariable m var) p
                
     doWaitFor a = return a
+
+-- | Declares a _sizes array for every array, statically sized or dynamically sized.
+-- For each record type it declares a _sizes array too.
+declareSizesArray :: Data t => t -> PassM t
+declareSizesArray = return -- TODO
+
+-- | Flattens all multi-dimensional arrays into one-dimensional arrays, transforming all indexes
+-- as appropriate.
+flattenArrays :: Data t => t -> PassM t
+flattenArrays = return -- TODO
diff --git a/backends/BackendPassesTest.hs b/backends/BackendPassesTest.hs
index 1085311..590cd69 100644
--- a/backends/BackendPassesTest.hs
+++ b/backends/BackendPassesTest.hs
@@ -22,10 +22,13 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 module BackendPassesTest (tests) where
 
 import Control.Monad.State
+import Data.Generics
+import qualified Data.Map as Map
 import Test.HUnit hiding (State)
 
 import qualified AST as A
 import BackendPasses
+import CompState
 import Metadata
 import Pattern
 import TagAST
@@ -141,12 +144,81 @@ testTransformWaitFor5 = TestCase $ testPass "testTransformWaitFor5" exp (transfo
     var1 = tag2 A.Variable DontCare varName1
     evar1 = tag2 A.ExprVariable DontCare var1
 
+testDeclareSizes :: Test
+testDeclareSizes = TestList
+  [
+    testFooVal 0 [4]
+   ,testFooVal 1 [4,5]
+   ,testFooVal 2 [4,5,6,7,8]
+   
+   ,testFooDecl 10 [Nothing]
+   ,testFooDecl 11 [Just 4, Nothing]
+   ,testFooDecl 12 [Nothing, Nothing]  
+   ,testFooDecl 13 [Nothing, Nothing, Nothing, Nothing]
+   ,testFooDecl 14 [Nothing, Just 5, Just 6]
+   ,testFooDecl 15 [Just 4, Nothing, Just 5, Nothing, Nothing]
+  ]
+  where
+    -- Tests static arrays (where the _sizes will be a val abbrev)
+    testFooVal :: Int -> [Int] -> Test
+    testFooVal n ns = test n (declFoo t $ valFooSizes ns $ term) (declFoo t term) (checkValFooSizes ns)
+      where
+        t = A.Array (map A.Dimension ns) A.Byte
 
+    -- Tests non-static arrays (where the _sizes will be declared but not initialised)
+    testFooDecl :: Int -> [Maybe Int] -> Test
+    testFooDecl n ns = test n (declFoo t $ declFooSizes (length ns) $ term) (declFoo t term) (checkDeclFooSizes $ length ns)
+      where
+        t = A.Array (map (maybe A.UnknownDimension A.Dimension) ns) A.Byte
+  
+    declFoo :: Data a => A.Type -> (A.Structured a -> A.Structured a)
+    declFoo t = A.Spec emptyMeta (A.Specification emptyMeta (simpleName "foo") $ A.Declaration emptyMeta t Nothing)
+
+    valFoo :: [Int] -> A.SpecType
+    valFoo ds = A.IsExpr emptyMeta A.ValAbbrev (A.Array [A.Dimension $ length ds] A.Int) $ makeSizesLiteral ds
+
+    valFooSizes :: Data a => [Int] -> (A.Structured a -> A.Structured a)
+    valFooSizes ds = A.Spec emptyMeta (A.Specification emptyMeta (simpleName "foo_sizes") $ valFoo ds)
+    
+    declFooSizes :: Data a => Int -> (A.Structured a -> A.Structured a)
+    declFooSizes x = A.Spec emptyMeta (A.Specification emptyMeta (simpleName "foo_sizes") $ A.Declaration emptyMeta (A.Array [A.Dimension x] A.Int) Nothing)
+    
+    makeSizesLiteral :: [Int] -> A.Expression
+    makeSizesLiteral xs = A.Literal emptyMeta (A.Array [A.Dimension $ length xs] A.Int) $ A.ArrayLiteral emptyMeta $
+      map (A.ArrayElemExpr . A.Literal emptyMeta A.Int . A.IntLiteral emptyMeta . show) xs
+    
+    checkValFooSizes :: [Int] -> CompState -> Assertion
+    checkValFooSizes ns cs
+      = do nd <- case Map.lookup "foo_sizes" (csNames cs) of
+             Just nd -> return nd
+             Nothing -> assertFailure "Could not find foo_sizes" >> return undefined
+           assertEqual "ndName" "foo_sizes" (A.ndName nd)
+           assertEqual "ndOrigName" "foo_sizes" (A.ndOrigName nd)
+           assertEqual "ndType" (valFoo ns) (A.ndType nd)
+           assertEqual "ndAbbrevMode" A.ValAbbrev (A.ndAbbrevMode nd)
+
+    checkDeclFooSizes :: Int -> CompState -> Assertion
+    checkDeclFooSizes x cs
+      = do nd <- case Map.lookup "foo_sizes" (csNames cs) of
+             Just nd -> return nd
+             Nothing -> assertFailure "Could not find foo_sizes" >> return undefined
+           assertEqual "ndName" "foo_sizes" (A.ndName nd)
+           assertEqual "ndOrigName" "foo_sizes" (A.ndOrigName nd)
+           assertEqual "ndType" (A.Declaration emptyMeta (A.Array [A.Dimension x] A.Int) Nothing) (A.ndType nd)
+           assertEqual "ndAbbrevMode" A.ValAbbrev (A.ndAbbrevMode nd)
+  
+    term = A.Only emptyMeta ()
+    
+    test :: Int -> A.Structured () -> A.Structured () -> (CompState -> Assertion) -> Test
+    test n exp inp chk = TestLabel label $ TestCase $ testPassWithStateCheck label exp (declareSizesArray inp) (return ()) chk
+      where
+        label = "testDeclareSizes " ++ show n
 ---Returns the list of tests:
 tests :: Test
 tests = TestLabel "BackendPassesTest" $ TestList
  [
-   testTransformWaitFor0
+   testDeclareSizes
+  ,testTransformWaitFor0
   ,testTransformWaitFor1
   ,testTransformWaitFor2
   ,testTransformWaitFor3