Added a test for genAssign in the C and C++ backends, and tweaked its implementation to pass the tests
This commit is contained in:
parent
d3fa9fb8c8
commit
38fb0baa4e
|
@ -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 ()
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user