Added a dummy implementation of a new pass, declareSizesArray, and the tests for it
This commit is contained in:
parent
2f7539bcdb
commit
81ea069707
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue
Block a user