diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs index 4bbd9c0..22e21b3 100644 --- a/backends/GenerateC.hs +++ b/backends/GenerateC.hs @@ -89,6 +89,7 @@ data GenOps = GenOps { 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), + -- | Generates a case statement over the given expression with the structured as the body. genCase :: GenOps -> Meta -> A.Expression -> A.Structured -> CGen (), genCheckedConversion :: GenOps -> Meta -> A.Type -> A.Type -> CGen () -> CGen (), genConversion :: GenOps -> Meta -> A.ConversionMode -> A.Type -> A.Expression -> CGen (), @@ -1629,33 +1630,32 @@ cgenIf ops m s --{{{ case cgenCase :: GenOps -> Meta -> A.Expression -> A.Structured -> CGen () cgenCase ops m e s - = do tell ["switch ("] + = do tell ["switch("] call genExpression ops e - tell [") {\n"] + tell ["){"] seenDefault <- genCaseBody (return ()) s when (not seenDefault) $ - do tell ["default:\n"] + do tell ["default:"] call genStop ops m "no option matched in CASE process" - tell ["}\n"] + tell ["}"] where -- FIXME -- can this be made common with genInputCaseBody above? genCaseBody :: CGen () -> A.Structured -> CGen Bool genCaseBody coll (A.Spec _ spec s) = genCaseBody (call genSpec ops spec coll) s genCaseBody coll (A.OnlyO _ (A.Option _ es p)) - = do sequence_ [tell ["case "] >> call genExpression ops e >> tell [":\n"] | e <- es] - tell ["{\n"] + = do sequence_ [tell ["case "] >> call genExpression ops e >> tell [":"] | e <- es] + tell ["{"] coll call genProcess ops p - tell ["break;\n"] - tell ["}\n"] + tell ["}break;"] return False genCaseBody coll (A.OnlyO _ (A.Else _ p)) - = do tell ["default:\n"] - tell ["{\n"] + = do tell ["default:"] + tell ["{"] coll call genProcess ops p - tell ["}\n"] + tell ["}break;"] return True genCaseBody coll (A.Several _ ss) = do seens <- mapM (genCaseBody coll) ss diff --git a/backends/GenerateCTest.hs b/backends/GenerateCTest.hs index fe508da..9ec23b3 100644 --- a/backends/GenerateCTest.hs +++ b/backends/GenerateCTest.hs @@ -58,6 +58,9 @@ dollar = tell ["$"] caret :: CGen () caret = tell ["^"] +hash :: CGen () +hash = tell ["#"] + foo :: A.Name foo = simpleName "foo" @@ -523,6 +526,28 @@ testAssign = TestList state t = defineName (simpleName "foo") $ simpleDefDecl "foo" t over ops = ops {genVariable = override1 at, genExpression = override1 dollar} +testCase :: Test +testCase = TestList + [ + testBothSame "testCase 0" "switch($){default:^}" ((tcall3 genCase emptyMeta e (A.Several emptyMeta [])) . over) + ,testBothSame "testCase 1" "switch($){default:{@}break;}" ((tcall3 genCase emptyMeta e (A.OnlyO emptyMeta $ A.Else emptyMeta p)) . over) + ,testBothSame "testCase 2" "switch($){default:{#@}break;}" ((tcall3 genCase emptyMeta e (spec $ A.OnlyO emptyMeta $ A.Else emptyMeta p)) . over) + + ,testBothSame "testCase 10" "switch($){case $:{@}break;default:^}" ((tcall3 genCase emptyMeta e (A.OnlyO emptyMeta $ A.Option emptyMeta [intLiteral 0] p)) . over) + + ,testBothSame "testCase 20" "switch($){case $:case $:{#@}break;default:{@}break;case $:{@}break;}" ((tcall3 genCase emptyMeta e $ A.Several emptyMeta + [spec $ A.OnlyO emptyMeta $ A.Option emptyMeta [e, e] p + ,A.OnlyO emptyMeta $ A.Else emptyMeta p + ,A.OnlyO emptyMeta $ A.Option emptyMeta [e] p] + ) . over) + ] + where + --The expression and process won't be used so we can use what we like: + e = A.True emptyMeta + p = A.Skip emptyMeta + spec = A.Spec emptyMeta undefined + over ops = ops {genExpression = override1 dollar, genProcess = override1 at, genStop = override2 caret, genSpec = override2 hash} + ---Returns the list of tests: tests :: Test tests = TestList @@ -531,6 +556,7 @@ tests = TestList ,testArraySizes ,testArraySubscript ,testAssign + ,testCase ,testDeclaration ,testDeclareInitFree ,testGenType