Added a test for genAssign in the C and C++ backends, and tweaked its implementation to pass the tests

This commit is contained in:
Neil Brown 2007-10-04 12:40:13 +00:00
parent d3fa9fb8c8
commit 38fb0baa4e
2 changed files with 46 additions and 15 deletions

View File

@ -64,7 +64,9 @@ instance Die CGen where
data GenOps = GenOps {
-- | Declares the C array of sizes for an occam array.
declareArraySizes :: GenOps -> [A.Dimension] -> A.Name -> CGen (),
-- | Generates code when a variable goes out of scope (e.g. deallocating memory).
declareFree :: GenOps -> Meta -> A.Type -> A.Variable -> Maybe (CGen ()),
-- | Generates code when a variable comes into scope (e.g. allocating memory, initialising variables).
declareInit :: GenOps -> Meta -> A.Type -> A.Variable -> Maybe (CGen ()),
declareType :: GenOps -> A.Type -> CGen (),
-- | Generates an individual parameter to a function\/proc.
@ -83,6 +85,7 @@ data GenOps = GenOps {
-- | Generates an array subscript for the given variable (with error checking if the Bool is True), using the given expression list as subscripts
genArraySubscript :: GenOps -> Bool -> A.Variable -> [A.Expression] -> CGen (),
genAssert :: GenOps -> Meta -> A.Expression -> CGen (),
-- | Generates an assignment statement with a single destination and single source.
genAssign :: GenOps -> Meta -> [A.Variable] -> A.ExpressionList -> CGen (),
genBytesIn :: GenOps -> A.Type -> Maybe A.Variable -> CGen (),
genBytesIn' :: GenOps -> A.Type -> Maybe A.Variable -> CGen (Maybe Int),
@ -1480,22 +1483,24 @@ cgenProcess ops p = case p of
--{{{ assignment
cgenAssign :: GenOps -> Meta -> [A.Variable] -> A.ExpressionList -> CGen ()
cgenAssign ops m [v] el
= case el of
A.FunctionCallList _ _ _ -> call genMissing ops "function call"
A.ExpressionList _ [e] ->
do t <- typeOfVariable v
doAssign t v e
cgenAssign ops m [v] (A.ExpressionList _ [e])
= do t <- typeOfVariable v
case call getScalarType ops t of
Just _ -> doAssign v e
Nothing -> case t of
-- Assignment of channel-ends, but not channels, is possible (at least in Rain):
A.Chan A.DirInput _ _ -> doAssign v e
A.Chan A.DirOutput _ _ -> doAssign v e
_ -> call genMissingC ops $ formatCode "assignment of type %" t
where
doAssign :: A.Type -> A.Variable -> A.Expression -> CGen ()
doAssign t v e
= case call getScalarType ops t of
Just _ ->
do call genVariable ops v
tell [" = "]
call genExpression ops e
tell [";\n"]
Nothing -> call genMissingC ops $ formatCode "assignment of type %" t
doAssign :: A.Variable -> A.Expression -> CGen ()
doAssign v e
= do call genVariable ops v
tell ["="]
call genExpression ops e
tell [";"]
cgenAssign ops m _ _ = call genMissing ops "Cannot perform assignment with multiple destinations or multiple sources"
--}}}
--{{{ input
cgenInput :: GenOps -> A.Variable -> A.InputMode -> CGen ()

View File

@ -498,6 +498,31 @@ testGenVariable = TestList
testSameA2 :: Int -> (String,String) -> (A.Variable -> A.Variable) -> A.Type -> Test
testSameA2 n (eO,eA) sub t = TestList [testSame n eO sub A.Original t,testSame (n+1) eA sub A.Abbrev t]
testAssign :: Test
testAssign = TestList
[
testBothSameS "testAssign 0" "@=$;" ((tcall3 genAssign emptyMeta [A.Variable emptyMeta foo] (A.ExpressionList emptyMeta [e])) . over) (state A.Int)
,testBothSameS "testAssign 1" "@=$;" ((tcall3 genAssign emptyMeta [A.Variable emptyMeta foo] (A.ExpressionList emptyMeta [e])) . over) (state A.Time)
,testBothSameS "testAssign 2" "@=$;" ((tcall3 genAssign emptyMeta [A.Variable emptyMeta foo] (A.ExpressionList emptyMeta [e])) . over)
(state $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int)
-- Fail because genAssign only handles one destination and one source:
,testBothFail "testAssign 100" (tcall3 genAssign emptyMeta [A.Variable emptyMeta foo,A.Variable emptyMeta foo] (A.ExpressionList emptyMeta [e]))
,testBothFail "testAssign 101" (tcall3 genAssign emptyMeta [A.Variable emptyMeta foo] (A.ExpressionList emptyMeta [e,e]))
,testBothFail "testAssign 102" (tcall3 genAssign emptyMeta [A.Variable emptyMeta foo,A.Variable emptyMeta foo] (A.ExpressionList emptyMeta [e, e]))
-- Fail because assignment can't be done with these types (should have already been transformed away):
,testBothFailS "testAssign 200" ((tcall3 genAssign emptyMeta [A.Variable emptyMeta foo] (A.ExpressionList emptyMeta [e])) . over)
(state $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int)
,testBothFailS "testAssign 201" ((tcall3 genAssign emptyMeta [A.Variable emptyMeta foo] (A.ExpressionList emptyMeta [e])) . over)
(state $ A.Record bar)
]
where
--The expression won't be examined so we can use what we like:
e = A.True emptyMeta
state t = defineName (simpleName "foo") $ simpleDefDecl "foo" t
over ops = ops {genVariable = override1 at, genExpression = override1 dollar}
---Returns the list of tests:
tests :: Test
tests = TestList
@ -505,6 +530,7 @@ tests = TestList
testActuals
,testArraySizes
,testArraySubscript
,testAssign
,testDeclaration
,testDeclareInitFree
,testGenType