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

This commit is contained in:
Neil Brown 2007-10-04 14:36:56 +00:00
parent af74ac1039
commit 1f8a5555ac
3 changed files with 36 additions and 13 deletions

View File

@ -109,6 +109,7 @@ data GenOps = GenOps {
genFuncMonadic :: GenOps -> Meta -> String -> A.Expression -> CGen (), genFuncMonadic :: GenOps -> Meta -> String -> A.Expression -> CGen (),
-- | Gets the current time into the given variable -- | Gets the current time into the given variable
genGetTime :: GenOps -> Meta -> A.Variable -> CGen (), genGetTime :: GenOps -> Meta -> A.Variable -> CGen (),
-- | Generates an IF statement (which can have replicators, specifications and such things inside it).
genIf :: GenOps -> Meta -> A.Structured -> CGen (), genIf :: GenOps -> Meta -> A.Structured -> CGen (),
genInput :: GenOps -> A.Variable -> A.InputMode -> CGen (), genInput :: GenOps -> A.Variable -> A.InputMode -> CGen (),
genInputCase :: GenOps -> Meta -> A.Variable -> A.Structured -> CGen (), genInputCase :: GenOps -> Meta -> A.Variable -> A.Structured -> CGen (),
@ -1613,20 +1614,21 @@ cgenSeq ops s = call genStructured ops s doP
cgenIf :: GenOps -> Meta -> A.Structured -> CGen () cgenIf :: GenOps -> Meta -> A.Structured -> CGen ()
cgenIf ops m s cgenIf ops m s
= do label <- makeNonce "if_end" = do label <- makeNonce "if_end"
tell ["/*",label,"*/"]
genIfBody label s genIfBody label s
call genStop ops m "no choice matched in IF process" call genStop ops m "no choice matched in IF process"
tell [label, ":\n;\n"] tell [label, ":;"]
where where
genIfBody :: String -> A.Structured -> CGen () genIfBody :: String -> A.Structured -> CGen ()
genIfBody label s = call genStructured ops s doC genIfBody label s = call genStructured ops s doC
where where
doC (A.OnlyC m (A.Choice m' e p)) doC (A.OnlyC m (A.Choice m' e p))
= do tell ["if ("] = do tell ["if("]
call genExpression ops e call genExpression ops e
tell [") {\n"] tell ["){"]
call genProcess ops p call genProcess ops p
tell ["goto ", label, ";\n"] tell ["goto ", label, ";"]
tell ["}\n"] tell ["}"]
--}}} --}}}
--{{{ case --{{{ case
cgenCase :: GenOps -> Meta -> A.Expression -> A.Structured -> CGen () cgenCase :: GenOps -> Meta -> A.Expression -> A.Structured -> CGen ()

View File

@ -1175,20 +1175,20 @@ cppgenUnfoldedVariable ops m var
cppgenIf :: GenOps -> Meta -> A.Structured -> CGen () cppgenIf :: GenOps -> Meta -> A.Structured -> CGen ()
cppgenIf ops m s cppgenIf ops m s
= do ifExc <- makeNonce "if_exc" = do ifExc <- makeNonce "if_exc"
tell ["class ",ifExc, " {}; try {"] tell ["class ",ifExc, "{};try{"]
genIfBody ifExc s genIfBody ifExc s
call genStop ops m "no choice matched in IF process" call genStop ops m "no choice matched in IF process"
tell ["} catch (",ifExc,") {}"] tell ["}catch(",ifExc,"){}"]
where where
genIfBody :: String -> A.Structured -> CGen () genIfBody :: String -> A.Structured -> CGen ()
genIfBody ifExc s = call genStructured ops s doC genIfBody ifExc s = call genStructured ops s doC
where where
doC (A.OnlyC m (A.Choice m' e p)) doC (A.OnlyC m (A.Choice m' e p))
= do tell ["if ("] = do tell ["if("]
call genExpression ops e call genExpression ops e
tell [") {\n"] tell ["){"]
call genProcess ops p call genProcess ops p
tell ["throw ",ifExc, "(); }\n"] tell ["throw ",ifExc, "();}"]
--}}} --}}}

View File

@ -148,12 +148,16 @@ testBothSameS ::
-> Test -> Test
testBothSameS n e a s = testBothS n e e a s testBothSameS n e a s = testBothS n e e a s
testBothSameR :: testBothR ::
String -- ^ Test Name String -- ^ Test Name
-> String -- ^ C and C++ expected -> String -- ^ C expected
-> String -- ^ C++ expected
-> (GenOps -> CGen ()) -- ^ Actual -> (GenOps -> CGen ()) -- ^ Actual
-> Test -> Test
testBothSameR n e a = TestCase $ (testRS n e (a cgenOps) (return ())) >> (testRS n e (a cppgenOps) (return ())) >> (return ()) testBothR n eC eCPP a = TestList [TestCase $ (testRS n eC (a cgenOps) (return ())) >> return (), TestCase $ (testRS n eCPP (a cppgenOps) (return ())) >> (return ())]
testBothSameR :: String -> String -> (GenOps -> CGen ()) -> Test
testBothSameR n e a = testBothR n e e a
testBothFail :: String -> (GenOps -> CGen ()) -> Test testBothFail :: String -> (GenOps -> CGen ()) -> Test
testBothFail a b = testBothFailS a b (return ()) testBothFail a b = testBothFailS a b (return ())
@ -553,6 +557,22 @@ testGetTime = testBoth "testGetTime 0" "ProcTime(&@);" "csp::CurrentTime(&@);" (
where where
over ops = ops {genVariable = override1 at} over ops = ops {genVariable = override1 at}
testIf :: Test
testIf = TestList
[
testBothR "testIf 0" "/\\*([[:alnum:]_]+)\\*/\\^\\1:;" "class ([[:alnum:]_]+)\\{\\};try\\{\\^\\}catch\\(\\1\\)\\{\\}"
((tcall2 genIf emptyMeta (A.Several emptyMeta [])) . over)
,testBothR "testIf 1" "/\\*([[:alnum:]_]+)\\*/if\\(\\$\\)\\{@goto \\1;\\}\\^\\1:;"
"class ([[:alnum:]_]+)\\{\\};try\\{if\\(\\$\\)\\{@throw \\1\\(\\);\\}\\^\\}catch\\(\\1\\)\\{\\}"
((tcall2 genIf emptyMeta (A.OnlyC emptyMeta $ A.Choice emptyMeta e p)) . over)
]
where
e :: A.Expression
e = undefined
p :: A.Process
p = undefined
over ops = ops {genExpression = override1 dollar, genProcess = override1 at, genStop = override2 caret, genSpec = override2 hash}
---Returns the list of tests: ---Returns the list of tests:
tests :: Test tests :: Test
tests = TestList tests = TestList
@ -567,6 +587,7 @@ tests = TestList
,testGenType ,testGenType
,testGenVariable ,testGenVariable
,testGetTime ,testGetTime
,testIf
,testOverArray ,testOverArray
,testReplicator ,testReplicator
,testStop ,testStop