Added a test for genBytesIn in the C and C++ backends
This commit is contained in:
parent
c1c1397f67
commit
5450f77963
|
@ -86,7 +86,9 @@ data GenOps = GenOps {
|
||||||
genAssert :: GenOps -> Meta -> A.Expression -> CGen (),
|
genAssert :: GenOps -> Meta -> A.Expression -> CGen (),
|
||||||
-- | Generates an assignment statement with a single destination and single source.
|
-- | Generates an assignment statement with a single destination and single source.
|
||||||
genAssign :: GenOps -> Meta -> [A.Variable] -> A.ExpressionList -> CGen (),
|
genAssign :: GenOps -> Meta -> [A.Variable] -> A.ExpressionList -> CGen (),
|
||||||
|
-- | Generates the number of bytes in a fixed size type
|
||||||
genBytesIn :: GenOps -> A.Type -> Maybe A.Variable -> CGen (),
|
genBytesIn :: GenOps -> A.Type -> Maybe A.Variable -> CGen (),
|
||||||
|
-- | Generates the number of bytes in a type that may have one free dimension
|
||||||
genBytesIn' :: GenOps -> A.Type -> Maybe A.Variable -> CGen (Maybe Int),
|
genBytesIn' :: GenOps -> A.Type -> Maybe A.Variable -> CGen (Maybe Int),
|
||||||
-- | Generates a case statement over the given expression with the structured as the body.
|
-- | Generates a case statement over the given expression with the structured as the body.
|
||||||
genCase :: GenOps -> Meta -> A.Expression -> A.Structured -> CGen (),
|
genCase :: GenOps -> Meta -> A.Expression -> A.Structured -> CGen (),
|
||||||
|
@ -121,8 +123,11 @@ data GenOps = GenOps {
|
||||||
genMissing :: GenOps -> String -> CGen (),
|
genMissing :: GenOps -> String -> CGen (),
|
||||||
genMissingC :: GenOps -> CGen String -> CGen (),
|
genMissingC :: GenOps -> CGen String -> CGen (),
|
||||||
genMonadic :: GenOps -> Meta -> A.MonadicOp -> A.Expression -> CGen (),
|
genMonadic :: GenOps -> Meta -> A.MonadicOp -> A.Expression -> CGen (),
|
||||||
|
-- | Generates an output statement.
|
||||||
genOutput :: GenOps -> A.Variable -> [A.OutputItem] -> CGen (),
|
genOutput :: GenOps -> A.Variable -> [A.OutputItem] -> CGen (),
|
||||||
|
-- | Generates an output statement for a tagged protocol.
|
||||||
genOutputCase :: GenOps -> A.Variable -> A.Name -> [A.OutputItem] -> CGen (),
|
genOutputCase :: GenOps -> A.Variable -> A.Name -> [A.OutputItem] -> CGen (),
|
||||||
|
-- | Generates an output for an individual item.
|
||||||
genOutputItem :: GenOps -> A.Variable -> A.OutputItem -> CGen (),
|
genOutputItem :: GenOps -> A.Variable -> A.OutputItem -> CGen (),
|
||||||
-- | Generates a loop that maps over every element in a (potentially multi-dimensional) array
|
-- | Generates a loop that maps over every element in a (potentially multi-dimensional) array
|
||||||
genOverArray :: GenOps -> Meta -> A.Variable -> (SubscripterFunction -> Maybe (CGen ())) -> CGen (),
|
genOverArray :: GenOps -> Meta -> A.Variable -> (SubscripterFunction -> Maybe (CGen ())) -> CGen (),
|
||||||
|
@ -413,14 +418,15 @@ cgenBytesIn' ops (A.Array ds t) v
|
||||||
genBytesInArray [] _ = return Nothing
|
genBytesInArray [] _ = return Nothing
|
||||||
genBytesInArray ((A.Dimension n):ds) i
|
genBytesInArray ((A.Dimension n):ds) i
|
||||||
= do free <- genBytesInArray ds (i + 1)
|
= do free <- genBytesInArray ds (i + 1)
|
||||||
tell [show n, " * "]
|
tell [show n, "*"]
|
||||||
return free
|
return free
|
||||||
genBytesInArray (A.UnknownDimension:ds) i
|
genBytesInArray (A.UnknownDimension:ds) i
|
||||||
= case v of
|
= case v of
|
||||||
Just rv ->
|
Just rv ->
|
||||||
do free <- genBytesInArray ds (i + 1)
|
do free <- genBytesInArray ds (i + 1)
|
||||||
call genVariable ops rv
|
call genVariable ops rv
|
||||||
tell ["_sizes[", show i, "] * "]
|
call genSizeSuffix ops (show i)
|
||||||
|
tell ["*"]
|
||||||
return free
|
return free
|
||||||
Nothing ->
|
Nothing ->
|
||||||
do free <- genBytesInArray ds (i + 1)
|
do free <- genBytesInArray ds (i + 1)
|
||||||
|
@ -428,18 +434,20 @@ cgenBytesIn' ops (A.Array ds t) v
|
||||||
Nothing -> return $ Just i
|
Nothing -> return $ Just i
|
||||||
Just _ -> die "genBytesIn' type with more than one free dimension"
|
Just _ -> die "genBytesIn' type with more than one free dimension"
|
||||||
cgenBytesIn' _ (A.Record n) _
|
cgenBytesIn' _ (A.Record n) _
|
||||||
= do tell ["sizeof ("]
|
= do tell ["sizeof("]
|
||||||
genName n
|
genName n
|
||||||
tell [")"]
|
tell [")"]
|
||||||
return Nothing
|
return Nothing
|
||||||
-- This is so that we can do RETYPES checks on channels; we don't actually
|
-- This is so that we can do RETYPES checks on channels; we don't actually
|
||||||
-- allow retyping between channels and other things.
|
-- allow retyping between channels and other things.
|
||||||
cgenBytesIn' _ (A.Chan {}) _
|
cgenBytesIn' ops t@(A.Chan {}) _
|
||||||
= do tell ["sizeof (Channel *)"]
|
= do tell ["sizeof("]
|
||||||
|
call genType ops t
|
||||||
|
tell [")"]
|
||||||
return Nothing
|
return Nothing
|
||||||
cgenBytesIn' ops t _
|
cgenBytesIn' ops t _
|
||||||
= case call getScalarType ops t of
|
= case call getScalarType ops t of
|
||||||
Just s -> tell ["sizeof (", s, ")"] >> return Nothing
|
Just s -> tell ["sizeof(", s, ")"] >> return Nothing
|
||||||
Nothing -> dieC $ formatCode "genBytesIn' %" t
|
Nothing -> dieC $ formatCode "genBytesIn' %" t
|
||||||
--}}}
|
--}}}
|
||||||
|
|
||||||
|
|
|
@ -768,6 +768,32 @@ testOutput = TestList
|
||||||
overOutputItem ops = ops {genOutputItem = override2 caret}
|
overOutputItem ops = ops {genOutputItem = override2 caret}
|
||||||
over ops = ops {genBytesIn = override2 caret}
|
over ops = ops {genBytesIn = override2 caret}
|
||||||
|
|
||||||
|
testBytesIn :: Test
|
||||||
|
testBytesIn = TestList
|
||||||
|
[
|
||||||
|
testBothSame "testBytesIn 0" "sizeof(int)" (tcall2 genBytesIn A.Int undefined)
|
||||||
|
,testBothSame "testBytesIn 1" "sizeof(foo)" (tcall2 genBytesIn (A.Record foo) undefined)
|
||||||
|
,testBoth "testBytesIn 2" "sizeof(Channel)" "sizeof(csp::One2OneChannel<int>)" (tcall2 genBytesIn (A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int) undefined)
|
||||||
|
,testBoth "testBytesIn 3" "sizeof(Channel*)" "sizeof(csp::Chanin<int>)" (tcall2 genBytesIn (A.Chan A.DirInput (A.ChanAttributes False False) A.Int) undefined)
|
||||||
|
|
||||||
|
--Array with a single known dimension:
|
||||||
|
,testBothSame "testBytesIn 100" "5*sizeof(int)" (tcall2 genBytesIn (A.Array [A.Dimension 5] A.Int) undefined)
|
||||||
|
--single unknown dimension, no variable:
|
||||||
|
,testBothFail "testBytesIn 101" (tcall2 genBytesIn (A.Array [A.UnknownDimension] A.Int) Nothing)
|
||||||
|
--single unknown dimension, with variable:
|
||||||
|
,testBothSame "testBytesIn 102" "$(@0)*sizeof(int)" ((tcall2 genBytesIn (A.Array [A.UnknownDimension] A.Int) (Just undefined)) . over)
|
||||||
|
|
||||||
|
--Array with all known dimensions:
|
||||||
|
,testBothSame "testBytesIn 200" "7*6*5*sizeof(int)" (tcall2 genBytesIn (A.Array [A.Dimension 5,A.Dimension 6, A.Dimension 7] A.Int) undefined)
|
||||||
|
--single unknown dimension, no variable:
|
||||||
|
,testBothFail "testBytesIn 201" (tcall2 genBytesIn (A.Array [A.Dimension 5,A.Dimension 6,A.UnknownDimension] A.Int) Nothing)
|
||||||
|
--single unknown dimension, with variable:
|
||||||
|
,testBothSame "testBytesIn 202" "$(@2)*6*5*sizeof(int)" ((tcall2 genBytesIn (A.Array [A.Dimension 5,A.Dimension 6,A.UnknownDimension] A.Int) (Just undefined)) . over)
|
||||||
|
|
||||||
|
]
|
||||||
|
where
|
||||||
|
over ops = ops {genVariable = override1 dollar, genSizeSuffix = (\_ n -> tell["(@",n,")"])}
|
||||||
|
|
||||||
---Returns the list of tests:
|
---Returns the list of tests:
|
||||||
tests :: Test
|
tests :: Test
|
||||||
tests = TestList
|
tests = TestList
|
||||||
|
@ -776,6 +802,7 @@ tests = TestList
|
||||||
,testArraySizes
|
,testArraySizes
|
||||||
,testArraySubscript
|
,testArraySubscript
|
||||||
,testAssign
|
,testAssign
|
||||||
|
,testBytesIn
|
||||||
,testCase
|
,testCase
|
||||||
,testDeclaration
|
,testDeclaration
|
||||||
,testDeclareInitFree
|
,testDeclareInitFree
|
||||||
|
|
Loading…
Reference in New Issue
Block a user