diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs index c6e98ec..a7c4c4c 100644 --- a/backends/GenerateC.hs +++ b/backends/GenerateC.hs @@ -109,6 +109,7 @@ data GenOps = GenOps { genFuncMonadic :: GenOps -> Meta -> String -> A.Expression -> CGen (), -- | Gets the current time into the given variable 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 (), genInput :: GenOps -> A.Variable -> A.InputMode -> 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 ops m s = do label <- makeNonce "if_end" + tell ["/*",label,"*/"] genIfBody label s call genStop ops m "no choice matched in IF process" - tell [label, ":\n;\n"] + tell [label, ":;"] where genIfBody :: String -> A.Structured -> CGen () genIfBody label s = call genStructured ops s doC where doC (A.OnlyC m (A.Choice m' e p)) - = do tell ["if ("] + = do tell ["if("] call genExpression ops e - tell [") {\n"] + tell ["){"] call genProcess ops p - tell ["goto ", label, ";\n"] - tell ["}\n"] + tell ["goto ", label, ";"] + tell ["}"] --}}} --{{{ case cgenCase :: GenOps -> Meta -> A.Expression -> A.Structured -> CGen () diff --git a/backends/GenerateCPPCSP.hs b/backends/GenerateCPPCSP.hs index 8ce4206..f3c7dcf 100644 --- a/backends/GenerateCPPCSP.hs +++ b/backends/GenerateCPPCSP.hs @@ -1175,20 +1175,20 @@ cppgenUnfoldedVariable ops m var cppgenIf :: GenOps -> Meta -> A.Structured -> CGen () cppgenIf ops m s = do ifExc <- makeNonce "if_exc" - tell ["class ",ifExc, " {}; try {"] + tell ["class ",ifExc, "{};try{"] genIfBody ifExc s call genStop ops m "no choice matched in IF process" - tell ["} catch (",ifExc,") {}"] + tell ["}catch(",ifExc,"){}"] where genIfBody :: String -> A.Structured -> CGen () genIfBody ifExc s = call genStructured ops s doC where doC (A.OnlyC m (A.Choice m' e p)) - = do tell ["if ("] + = do tell ["if("] call genExpression ops e - tell [") {\n"] + tell ["){"] call genProcess ops p - tell ["throw ",ifExc, "(); }\n"] + tell ["throw ",ifExc, "();}"] --}}} diff --git a/backends/GenerateCTest.hs b/backends/GenerateCTest.hs index d9a3cbc..4e03cc9 100644 --- a/backends/GenerateCTest.hs +++ b/backends/GenerateCTest.hs @@ -148,12 +148,16 @@ testBothSameS :: -> Test testBothSameS n e a s = testBothS n e e a s -testBothSameR :: +testBothR :: String -- ^ Test Name - -> String -- ^ C and C++ expected + -> String -- ^ C expected + -> String -- ^ C++ expected -> (GenOps -> CGen ()) -- ^ Actual -> 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 a b = testBothFailS a b (return ()) @@ -553,6 +557,22 @@ testGetTime = testBoth "testGetTime 0" "ProcTime(&@);" "csp::CurrentTime(&@);" ( where 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: tests :: Test tests = TestList @@ -567,6 +587,7 @@ tests = TestList ,testGenType ,testGenVariable ,testGetTime + ,testIf ,testOverArray ,testReplicator ,testStop