Added a test for genBytesIn in the C and C++ backends

This commit is contained in:
Neil Brown 2007-10-07 11:47:39 +00:00
parent c1c1397f67
commit 5450f77963
2 changed files with 41 additions and 6 deletions

View File

@ -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
--}}} --}}}

View File

@ -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