Added a dummy implementation of a new pass, declareSizesArray, and the tests for it

This commit is contained in:
Neil Brown 2008-03-03 15:02:07 +00:00
parent 2f7539bcdb
commit 81ea069707
2 changed files with 83 additions and 1 deletions

View File

@ -74,3 +74,13 @@ transformWaitFor = doGeneric `extM` doAlt
return $ A.AlternativeWait m A.WaitUntil (A.ExprVariable m var) p return $ A.AlternativeWait m A.WaitUntil (A.ExprVariable m var) p
doWaitFor a = return a 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

View File

@ -22,10 +22,13 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
module BackendPassesTest (tests) where module BackendPassesTest (tests) where
import Control.Monad.State import Control.Monad.State
import Data.Generics
import qualified Data.Map as Map
import Test.HUnit hiding (State) import Test.HUnit hiding (State)
import qualified AST as A import qualified AST as A
import BackendPasses import BackendPasses
import CompState
import Metadata import Metadata
import Pattern import Pattern
import TagAST import TagAST
@ -141,12 +144,81 @@ testTransformWaitFor5 = TestCase $ testPass "testTransformWaitFor5" exp (transfo
var1 = tag2 A.Variable DontCare varName1 var1 = tag2 A.Variable DontCare varName1
evar1 = tag2 A.ExprVariable DontCare var1 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: ---Returns the list of tests:
tests :: Test tests :: Test
tests = TestLabel "BackendPassesTest" $ TestList tests = TestLabel "BackendPassesTest" $ TestList
[ [
testTransformWaitFor0 testDeclareSizes
,testTransformWaitFor0
,testTransformWaitFor1 ,testTransformWaitFor1
,testTransformWaitFor2 ,testTransformWaitFor2
,testTransformWaitFor3 ,testTransformWaitFor3