From 4f83187549d52d5ec93055e7244e8bd890a8d649 Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Thu, 29 Jan 2009 00:56:32 +0000 Subject: [PATCH] Fixed up all the tests in light of the new recursive procs --- backends/BackendPassesTest.hs | 2 +- common/OccamEDSL.hs | 2 +- common/TestUtils.hs | 4 ++-- frontends/OccamTypesTest.hs | 8 ++++---- frontends/ParseRainTest.hs | 10 +++++----- frontends/RainPassesTest.hs | 26 +++++++++++++------------- transformations/PassTest.hs | 11 ++++++----- transformations/SimplifyAbbrevsTest.hs | 8 ++++---- 8 files changed, 36 insertions(+), 35 deletions(-) diff --git a/backends/BackendPassesTest.hs b/backends/BackendPassesTest.hs index f47f471..b3c2175 100644 --- a/backends/BackendPassesTest.hs +++ b/backends/BackendPassesTest.hs @@ -384,7 +384,7 @@ qcTestSizeParameters = | (n, t) <- zip [(0::Integer)..] ts] makeProcDef :: [(String, A.Type, A.AbbrevMode)] -> A.SpecType - makeProcDef nts = A.Proc emptyMeta A.PlainSpec [A.Formal am t (simpleName n) | (n, t, am) <- nts] (A.Skip emptyMeta) + makeProcDef nts = A.Proc emptyMeta (A.PlainSpec, A.PlainRec) [A.Formal am t (simpleName n) | (n, t, am) <- nts] (A.Skip emptyMeta) recordProcDef :: [(String, A.Type, A.AbbrevMode)] -> State CompState () recordProcDef nts = defineTestName "p" (makeProcDef nts) A.Original diff --git a/common/OccamEDSL.hs b/common/OccamEDSL.hs index b68ef0f..cda7e2a 100644 --- a/common/OccamEDSL.hs +++ b/common/OccamEDSL.hs @@ -250,7 +250,7 @@ oPROC str params body scope = do s <- scope defineProc str [(A.nameName name, A.Original, t) | (t, A.Variable _ name) <- params] return $ A.Spec emptyMeta (A.Specification emptyMeta (simpleName str) $ - A.Proc emptyMeta A.PlainSpec formals p + A.Proc emptyMeta (A.PlainSpec, A.PlainRec) formals p ) (singlify s) where formals = [A.Formal A.Original t n | (t, A.Variable _ n) <- params] diff --git a/common/TestUtils.hs b/common/TestUtils.hs index abce2f5..0306601 100644 --- a/common/TestUtils.hs +++ b/common/TestUtils.hs @@ -111,7 +111,7 @@ testCheck config property = -- | Wraps a structured process into a complete AST fragment. wrapProcSeq :: A.Structured A.Process -> A.AST wrapProcSeq x = A.Spec emptyMeta (A.Specification emptyMeta (simpleName "foo") - $ A.Proc emptyMeta A.PlainSpec [] $ A.Seq emptyMeta x) (A.Several emptyMeta []) + $ A.Proc emptyMeta (A.PlainSpec, A.PlainRec) [] $ A.Seq emptyMeta x) (A.Several emptyMeta []) -- | Helper function to generate an array dimension. @@ -377,7 +377,7 @@ defineProc :: CSM m => String -> [(String, A.AbbrevMode, A.Type)] -> m () defineProc s as = defineThing s st A.Original A.NameUser where - st = A.Proc emptyMeta A.PlainSpec fs $ A.Skip emptyMeta + st = A.Proc emptyMeta (A.PlainSpec, A.PlainRec) fs $ A.Skip emptyMeta fs = [A.Formal am t (simpleName s) | (s, am, t) <- as] -- | Define a protocol. diff --git a/frontends/OccamTypesTest.hs b/frontends/OccamTypesTest.hs index 0ad4362..0172fc7 100644 --- a/frontends/OccamTypesTest.hs +++ b/frontends/OccamTypesTest.hs @@ -461,15 +461,15 @@ testOccamTypes = TestList ] -- Proc - , testOK 2090 $ A.Proc m A.PlainSpec [] skip - , testOK 2091 $ A.Proc m A.InlineSpec [] skip - , testOK 2092 $ A.Proc m A.PlainSpec + , testOK 2090 $ A.Proc m (A.PlainSpec, A.PlainRec) [] skip + , testOK 2091 $ A.Proc m (A.InlineSpec, A.PlainRec) [] skip + , testOK 2092 $ A.Proc m (A.PlainSpec, A.PlainRec) [ A.Formal A.Abbrev A.Int (simpleName "x") , A.Formal A.ValAbbrev A.Int (simpleName "y") , A.Formal A.Abbrev chanIntT (simpleName "c") ] skip - , testFail 2093 $ A.Proc m A.PlainSpec + , testFail 2093 $ A.Proc m (A.PlainSpec, A.PlainRec) [ A.Formal A.Original A.Int (simpleName "x") ] skip diff --git a/frontends/ParseRainTest.hs b/frontends/ParseRainTest.hs index 4ed9925..8cae4e5 100644 --- a/frontends/ParseRainTest.hs +++ b/frontends/ParseRainTest.hs @@ -485,21 +485,21 @@ testTopLevelDecl :: [ParseTest A.AST] testTopLevelDecl = [ passTop (0, "process noargs() {}", - [A.Spec m (A.Specification m (simpleName "noargs") $ A.Proc m A.PlainSpec [] emptyBlock) emptySeveral]) + [A.Spec m (A.Specification m (simpleName "noargs") $ A.Proc m (A.PlainSpec, A.Recursive) [] emptyBlock) emptySeveral]) ,passTop (1, "process onearg(int: x) {x = 0;}", - [A.Spec m (A.Specification m (simpleName "onearg") $ A.Proc m A.PlainSpec + [A.Spec m (A.Specification m (simpleName "onearg") $ A.Proc m (A.PlainSpec, A.Recursive) [A.Formal A.ValAbbrev A.Int (simpleName "x")] $ makeSeq [makeAssign (variable "x") (intLiteral 0)]) emptySeveral ]) ,passTop (2, "process noargs0() {} process noargs1 () {}", - [A.Spec m (A.Specification m (simpleName "noargs0") $ A.Proc m A.PlainSpec [] emptyBlock) emptySeveral - ,A.Spec m (A.Specification m (simpleName "noargs1") $ A.Proc m A.PlainSpec [] emptyBlock) emptySeveral]) + [A.Spec m (A.Specification m (simpleName "noargs0") $ A.Proc m (A.PlainSpec, A.Recursive) [] emptyBlock) emptySeveral + ,A.Spec m (A.Specification m (simpleName "noargs1") $ A.Proc m (A.PlainSpec, A.Recursive) [] emptyBlock) emptySeveral]) ,passTop (4, "process noargs() par {}", - [A.Spec m (A.Specification m (simpleName "noargs") $ A.Proc m A.PlainSpec [] $ A.Par m A.PlainPar emptySeveral) emptySeveral]) + [A.Spec m (A.Specification m (simpleName "noargs") $ A.Proc m (A.PlainSpec, A.Recursive) [] $ A.Par m A.PlainPar emptySeveral) emptySeveral]) , fail ("process", RP.topLevelDecl) , fail ("process () {}", RP.topLevelDecl) diff --git a/frontends/RainPassesTest.hs b/frontends/RainPassesTest.hs index 6115ab9..af5e4bb 100644 --- a/frontends/RainPassesTest.hs +++ b/frontends/RainPassesTest.hs @@ -175,20 +175,20 @@ testUnique2b = TestCase $ testPassWithItemsStateCheck "testUnique2b" exp uniquif testUnique3 :: Test testUnique3 = TestCase $ testPassWithItemsStateCheck "testUnique3" exp uniquifyAndResolveVars orig (return ()) check where - orig = A.Spec m (A.Specification m (procName "foo") $ A.Proc m A.PlainSpec [] $ A.Skip m) (A.Only m $ A.ProcCall m (procName "foo") []) + orig = A.Spec m (A.Specification m (procName "foo") $ A.Proc m (A.PlainSpec, A.Recursive) [] $ A.Skip m) (A.Only m $ A.ProcCall m (procName "foo") []) exp = orig check (items,state) = assertVarDef "testUnique3: Variable was not recorded" state "foo" (tag7 A.NameDef DontCare "foo" "foo" - (A.Proc m A.PlainSpec [] $ A.Skip m) A.Original A.NameUser A.Unplaced) + (A.Proc m (A.PlainSpec, A.Recursive) [] $ A.Skip m) A.Original A.NameUser A.Unplaced) -- | Tests that parameters are uniquified and resolved: testUnique4 :: Test testUnique4 = TestCase $ testPassWithItemsStateCheck "testUnique4" exp uniquifyAndResolveVars orig (return ()) check where - orig = A.Spec m (A.Specification m (procName "foo") $ A.Proc m A.PlainSpec [A.Formal A.ValAbbrev A.Byte $ simpleName "c"] $ + orig = A.Spec m (A.Specification m (procName "foo") $ A.Proc m (A.PlainSpec, A.Recursive) [A.Formal A.ValAbbrev A.Byte $ simpleName "c"] $ A.ProcCall m (procName "foo") [A.ActualExpression $ exprVariable "c"]) (skipP) exp = mSpecP - (tag3 A.Specification DontCare (procNamePattern "foo") $ tag4 A.Proc DontCare A.PlainSpec + (tag3 A.Specification DontCare (procNamePattern "foo") $ tag4 A.Proc DontCare (A.PlainSpec, A.Recursive) [tag3 A.Formal A.ValAbbrev A.Byte newc] (bodyPattern newc) ) @@ -206,7 +206,7 @@ testUnique4 = TestCase $ testPassWithItemsStateCheck "testUnique4" exp uniquifyA (A.Declaration m A.Byte) A.ValAbbrev A.NameUser A.Unplaced) assertVarDef "testUnique4: Variable was not recorded" state "foo" (tag7 A.NameDef DontCare "foo" "foo" - (tag4 A.Proc DontCare A.PlainSpec + (tag4 A.Proc DontCare (A.PlainSpec, A.Recursive) [tag3 A.Formal A.ValAbbrev A.Byte newcName] (bodyPattern newcName)) A.Original A.NameUser A.Unplaced) @@ -226,9 +226,9 @@ testUnique4 = TestCase $ testPassWithItemsStateCheck "testUnique4" exp uniquifyA testFindMain0 :: Test testFindMain0 = TestCase $ testPassWithItemsStateCheck "testFindMain0" exp (uniquifyAndResolveVars >>> findMain) orig (return ()) check where - orig = A.Spec m (A.Specification m (A.Name m "main") $ A.Proc m A.PlainSpec [] (A.Skip m)) $ A.Several m [] :: A.AST + orig = A.Spec m (A.Specification m (A.Name m "main") $ A.Proc m (A.PlainSpec, A.Recursive) [] (A.Skip m)) $ A.Several m [] :: A.AST exp = mSpecAST (tag3 A.Specification DontCare (tag2 A.Name DontCare ("main"@@DontCare)) $ - tag4 A.Proc DontCare A.PlainSpec ([] :: [A.Formal]) (tag1 A.Skip DontCare)) $ mSeveralAST ([] :: [A.AST]) + tag4 A.Proc DontCare (A.PlainSpec, A.Recursive) ([] :: [A.Formal]) (tag1 A.Skip DontCare)) $ mSeveralAST ([] :: [A.AST]) check (items,state) = do mainName <- castAssertADI (Map.lookup "main" items) assertNotEqual "testFindMain0 A" "main" mainName @@ -239,18 +239,18 @@ testFindMain0 = TestCase $ testPassWithItemsStateCheck "testFindMain0" exp (uniq testFindMain1 :: Test testFindMain1 = TestCase $ testPassWithStateCheck "testFindMain1" orig (uniquifyAndResolveVars >>> findMain) orig (return ()) check where - orig = A.Spec m (A.Specification m (A.Name m "foo") $ A.Proc m A.PlainSpec [] (A.Skip m)) $ A.Several m ([] :: [A.AST]) + orig = A.Spec m (A.Specification m (A.Name m "foo") $ A.Proc m (A.PlainSpec, A.Recursive) [] (A.Skip m)) $ A.Several m ([] :: [A.AST]) check state = assertEqual "testFindMain1" [] (csMainLocals state) testFindMain2 :: Test testFindMain2 = TestCase $ testPassWithItemsStateCheck "testFindMain2" exp (uniquifyAndResolveVars >>> findMain) orig (return ()) check where - inner = A.Spec m (A.Specification m (A.Name m "foo") $ A.Proc m A.PlainSpec [] (A.Skip m)) $ + inner = A.Spec m (A.Specification m (A.Name m "foo") $ A.Proc m (A.PlainSpec, A.Recursive) [] (A.Skip m)) $ A.Several m ([] :: [A.AST]) - orig = A.Spec m (A.Specification m (A.Name m "main") $ A.Proc m A.PlainSpec [] (A.Skip m)) inner + orig = A.Spec m (A.Specification m (A.Name m "main") $ A.Proc m (A.PlainSpec, A.Recursive) [] (A.Skip m)) inner exp = mSpecAST (tag3 A.Specification DontCare (tag2 A.Name DontCare ("main"@@DontCare)) $ - tag4 A.Proc DontCare A.PlainSpec ([] :: [A.Formal]) (tag1 A.Skip DontCare)) (stopCaringPattern m $ mkPattern inner) + tag4 A.Proc DontCare (A.PlainSpec, A.Recursive) ([] :: [A.Formal]) (tag1 A.Skip DontCare)) (stopCaringPattern m $ mkPattern inner) check (items,state) = do mainName <- castAssertADI (Map.lookup "main" items) assertNotEqual "testFindMain2 A" "main" mainName @@ -274,12 +274,12 @@ testParamPass testName formals params transParams startStateProc = do defineName (simpleName "x") $ simpleDefDecl "x" (A.UInt16) case formals of Nothing -> return () - Just formals' -> defineName (procName "foo") $ simpleDef "foo" $ A.Proc m A.PlainSpec formals' (A.Skip m) + Just formals' -> defineName (procName "foo") $ simpleDef "foo" $ A.Proc m (A.PlainSpec, A.Recursive) formals' (A.Skip m) startStateFunc :: State CompState () startStateFunc = do defineName (simpleName "x") $ simpleDefDecl "x" (A.UInt16) case formals of Nothing -> return () - Just formals' -> defineName (funcName "foo") $ simpleDef "foo" $ A.Function m (A.PlainSpec,A.PlainRec) [A.Byte] formals' (Left $ A.Only m $ A.ExpressionList m []) + Just formals' -> defineName (funcName "foo") $ simpleDef "foo" $ A.Function m (A.PlainSpec,A.Recursive) [A.Byte] formals' (Left $ A.Only m $ A.ExpressionList m []) origProc = A.ProcCall m (procName "foo") params expProc ps = A.ProcCall m (procName "foo") ps origFunc = A.FunctionCall m (funcName "foo") (deActualise params) diff --git a/transformations/PassTest.hs b/transformations/PassTest.hs index 9987e5c..3cff97d 100644 --- a/transformations/PassTest.hs +++ b/transformations/PassTest.hs @@ -74,7 +74,7 @@ singleParamBodyExp = tag2 A.Seq DontCare $ mOnlyP $ -- | Returns the expected specification type of the single parameter process singleParamSpecExp :: Pattern -> Pattern -- ^ to match: A.SpecType -singleParamSpecExp body = tag4 A.Proc DontCare A.PlainSpec [tag3 A.Formal A.ValAbbrev A.Byte (simpleName "param0"), tag3 A.Formal A.Abbrev A.Int (Named "ret0" DontCare)] body +singleParamSpecExp body = tag4 A.Proc DontCare (A.PlainSpec, A.PlainRec) [tag3 A.Formal A.ValAbbrev A.Byte (simpleName "param0"), tag3 A.Formal A.Abbrev A.Int (Named "ret0" DontCare)] body -- | Tests a function with a single return, and a single parameter. testFunctionsToProcs0 :: Test @@ -99,10 +99,11 @@ testFunctionsToProcs0 = TestCase $ testPassWithItemsStateCheck "testFunctionsToP testFunctionsToProcs1 :: Test testFunctionsToProcs1 = TestCase $ testPassWithItemsStateCheck "testFunctionsToProcs1 A" exp functionsToProcs orig (return ()) check where - orig = A.Specification m (simpleName "foo") (A.Function m (A.PlainSpec, A.PlainRec) [A.Int,A.Real32] + orig = A.Specification m (simpleName "foo") (A.Function m (A.PlainSpec, A.Recursive) [A.Int,A.Real32] [A.Formal A.ValAbbrev A.Byte (simpleName "param0"),A.Formal A.Abbrev A.Real32 (simpleName "param1")] (Left $ valofTwo "param0" "param1")) exp = tag3 A.Specification DontCare (simpleName "foo") procBody - procBody = tag4 A.Proc DontCare A.PlainSpec [tag3 A.Formal A.ValAbbrev A.Byte (simpleName "param0"), + procBody = tag4 A.Proc DontCare (A.PlainSpec, A.Recursive) + [tag3 A.Formal A.ValAbbrev A.Byte (simpleName "param0"), tag3 A.Formal A.Abbrev A.Real32 (simpleName "param1"), tag3 A.Formal A.Abbrev A.Int (Named "ret0" DontCare), tag3 A.Formal A.Abbrev A.Real32 (Named "ret1" DontCare)] $ @@ -136,7 +137,7 @@ testFunctionsToProcs2 = TestCase $ testPassWithItemsStateCheck "testFunctionsToP A.PlainRec) [A.Int] [A.Formal A.ValAbbrev A.Byte (simpleName "paramOuter0")] $ Left $ A.Spec m (singleParamFunc valof0) valof0) exp = tag3 A.Specification DontCare (simpleName "fooOuter") procBodyOuter - procHeader body = tag4 A.Proc DontCare A.PlainSpec [tag3 A.Formal A.ValAbbrev A.Byte (simpleName "paramOuter0"), tag3 A.Formal A.Abbrev A.Int (Named "retOuter0" DontCare)] body + procHeader body = tag4 A.Proc DontCare (A.PlainSpec, A.PlainRec) [tag3 A.Formal A.ValAbbrev A.Byte (simpleName "paramOuter0"), tag3 A.Formal A.Abbrev A.Int (Named "retOuter0" DontCare)] body procBodyOuter = procHeader $ tag2 A.Seq DontCare $ mSpecP (tag3 A.Specification DontCare (simpleName "foo") (singleParamSpecExp singleParamBodyExp)) $ @@ -191,7 +192,7 @@ testFunctionsToProcs4 = TestCase $ testPassWithItemsStateCheck "testFunctionsToP [A.Formal A.ValAbbrev A.Byte (simpleName "param0"),A.Formal A.Abbrev A.Real32 (simpleName "param1")] $ Right $ A.Seq m $ A.Only m $ A.Assign m [variable "foo"] $ A.ExpressionList m [exprVariable "param0", exprVariable "param1"]) exp = tag3 A.Specification DontCare (simpleName "foo") procBody - procBody = tag4 A.Proc DontCare A.PlainSpec [tag3 A.Formal A.ValAbbrev A.Byte (simpleName "param0"), + procBody = tag4 A.Proc DontCare (A.PlainSpec, A.PlainRec) [tag3 A.Formal A.ValAbbrev A.Byte (simpleName "param0"), tag3 A.Formal A.Abbrev A.Real32 (simpleName "param1"), tag3 A.Formal A.Abbrev A.Int (Named "ret0" DontCare), tag3 A.Formal A.Abbrev A.Real32 (Named "ret1" DontCare)] $ diff --git a/transformations/SimplifyAbbrevsTest.hs b/transformations/SimplifyAbbrevsTest.hs index 9e21979..c74e556 100644 --- a/transformations/SimplifyAbbrevsTest.hs +++ b/transformations/SimplifyAbbrevsTest.hs @@ -58,11 +58,11 @@ testRemoveInitial = TestLabel "testRemoveInitial" $ TestList -- INITIAL formal , ok 30 (spec foo (A.Proc m - A.PlainSpec + (A.PlainSpec, A.PlainRec) [A.Formal A.InitialAbbrev A.Int bar] skip) inner) - (mSpec foo (mProc A.PlainSpec + (mSpec foo (mProc (A.PlainSpec, A.PlainRec) [mFormal' A.ValAbbrev A.Int mTemp] (mSeq (mDeclareAssign bar A.Int mTempE @@ -71,14 +71,14 @@ testRemoveInitial = TestLabel "testRemoveInitial" $ TestList -- Two INITIAL formals and a regular VAL formal , ok 40 (spec foo (A.Proc m - A.PlainSpec + (A.PlainSpec, A.PlainRec) [ A.Formal A.InitialAbbrev A.Int bar , A.Formal A.ValAbbrev A.Int baz , A.Formal A.InitialAbbrev A.Int quux ] skip) inner) - (mSpec foo (mProc A.PlainSpec + (mSpec foo (mProc (A.PlainSpec, A.PlainRec) [ mFormal' A.ValAbbrev A.Int mTemp , mFormal' A.ValAbbrev A.Int baz , mFormal' A.ValAbbrev A.Int mTemp2