suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fixed up all the tests in light of the new recursive procs

Browse Source
This commit is contained in:
Neil Brown 2009-01-29 00:56:32 +00:00
parent 8a28d765e7
commit 4f83187549
8 changed files with 36 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
backends/BackendPassesTest.hs
View File

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

2
common/OccamEDSL.hs
View File

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

4
common/TestUtils.hs
View File

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

8
frontends/OccamTypesTest.hs
View File

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

10
frontends/ParseRainTest.hs
View File

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

26
frontends/RainPassesTest.hs
View File

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

11
transformations/PassTest.hs
View File

@ -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)] $

8
transformations/SimplifyAbbrevsTest.hs
View File

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