Updated all the tests to work with the new recursive functions

This commit is contained in:
Neil Brown 2009-01-29 00:34:12 +00:00
parent 7722e95dfd
commit 10e6b4ce02
5 changed files with 21 additions and 18 deletions

View File

@ -369,7 +369,7 @@ defineFunction :: String -> [A.Type] -> [(String, A.Type)]
defineFunction s rs as defineFunction s rs as
= defineThing s st A.Original A.NameUser = defineThing s st A.Original A.NameUser
where where
st = A.Function emptyMeta A.PlainSpec rs fs (Right $ A.Skip emptyMeta) st = A.Function emptyMeta (A.PlainSpec, A.PlainRec) rs fs (Right $ A.Skip emptyMeta)
fs = [A.Formal A.ValAbbrev t (simpleName s) | (s, t) <- as] fs = [A.Formal A.ValAbbrev t (simpleName s) | (s, t) <- as]
-- | Define a proc. -- | Define a proc.

View File

@ -475,23 +475,23 @@ testOccamTypes = TestList
skip skip
-- Function -- Function
, testOK 2100 $ A.Function m A.PlainSpec [A.Int] [] returnOne , testOK 2100 $ A.Function m (A.PlainSpec, A.PlainRec) [A.Int] [] returnOne
, testOK 2110 $ A.Function m A.InlineSpec [A.Int] [] returnOne , testOK 2110 $ A.Function m (A.InlineSpec, A.PlainRec) [A.Int] [] returnOne
, testFail 2120 $ A.Function m A.PlainSpec [] [] returnNone , testFail 2120 $ A.Function m (A.PlainSpec, A.PlainRec) [] [] returnNone
, testOK 2130 $ A.Function m A.PlainSpec [A.Int] , testOK 2130 $ A.Function m (A.PlainSpec, A.PlainRec) [A.Int]
[ A.Formal A.ValAbbrev A.Int (simpleName "x") [ A.Formal A.ValAbbrev A.Int (simpleName "x")
, A.Formal A.ValAbbrev A.Bool (simpleName "b") , A.Formal A.ValAbbrev A.Bool (simpleName "b")
, A.Formal A.ValAbbrev A.Int (simpleName "q") , A.Formal A.ValAbbrev A.Int (simpleName "q")
] ]
returnOne returnOne
, testFail 2140 $ A.Function m A.PlainSpec [A.Int] , testFail 2140 $ A.Function m (A.PlainSpec, A.PlainRec) [A.Int]
[A.Formal A.Abbrev A.Int (simpleName "x")] [A.Formal A.Abbrev A.Int (simpleName "x")]
returnOne returnOne
, testFail 2150 $ A.Function m A.PlainSpec [A.Int] , testFail 2150 $ A.Function m (A.PlainSpec, A.PlainRec) [A.Int]
[A.Formal A.ValAbbrev chanIntT (simpleName "c")] [A.Formal A.ValAbbrev chanIntT (simpleName "c")]
returnOne returnOne
, testFail 2160 $ A.Function m A.PlainSpec [A.Int] [] returnNone , testFail 2160 $ A.Function m (A.PlainSpec, A.PlainRec) [A.Int] [] returnNone
, testFail 2170 $ A.Function m A.PlainSpec [A.Int] [] returnTwo , testFail 2170 $ A.Function m (A.PlainSpec, A.PlainRec) [A.Int] [] returnTwo
--}}} --}}}
--{{{ retyping --{{{ retyping

View File

@ -511,16 +511,16 @@ testTopLevelDecl =
, fail ("process foo (int x) {}", RP.topLevelDecl) , fail ("process foo (int x) {}", RP.topLevelDecl)
,passTop (100, "function uint8: cons() {}", ,passTop (100, "function uint8: cons() {}",
[A.Spec m (A.Specification m (simpleName "cons") $ A.Function m A.PlainSpec [A.Byte] [] $ Right emptyBlock) emptySeveral]) [A.Spec m (A.Specification m (simpleName "cons") $ A.Function m (A.PlainSpec,A.Recursive) [A.Byte] [] $ Right emptyBlock) emptySeveral])
,passTop (101, "function uint8: f(uint8: x) {}", ,passTop (101, "function uint8: f(uint8: x) {}",
[A.Spec m (A.Specification m (simpleName "f") $ [A.Spec m (A.Specification m (simpleName "f") $
A.Function m A.PlainSpec [A.Byte] [A.Formal A.ValAbbrev A.Byte (simpleName "x")] $ Right emptyBlock) A.Function m (A.PlainSpec, A.Recursive) [A.Byte] [A.Formal A.ValAbbrev A.Byte (simpleName "x")] $ Right emptyBlock)
emptySeveral]) emptySeveral])
,passTop (102, "function uint8: id(uint8: x) {return x;}", ,passTop (102, "function uint8: id(uint8: x) {return x;}",
[A.Spec m (A.Specification m (simpleName "id") $ [A.Spec m (A.Specification m (simpleName "id") $
A.Function m A.PlainSpec [A.Byte] [A.Formal A.ValAbbrev A.Byte (simpleName "x")] $ Right $ A.Function m (A.PlainSpec, A.Recursive) [A.Byte] [A.Formal A.ValAbbrev A.Byte (simpleName "x")] $ Right $
A.Seq m $ A.Several m [A.Only m $ A.Assign m [variable "id"] (A.ExpressionList m [exprVariable "x"])]) A.Seq m $ A.Several m [A.Only m $ A.Assign m [variable "id"] (A.ExpressionList m [exprVariable "x"])])
emptySeveral]) emptySeveral])
] ]

View File

@ -279,7 +279,7 @@ testParamPass testName formals params transParams
startStateFunc = do defineName (simpleName "x") $ simpleDefDecl "x" (A.UInt16) startStateFunc = do defineName (simpleName "x") $ simpleDefDecl "x" (A.UInt16)
case formals of case formals of
Nothing -> return () Nothing -> return ()
Just formals' -> defineName (funcName "foo") $ simpleDef "foo" $ A.Function m A.PlainSpec [A.Byte] formals' (Left $ A.Only m $ A.ExpressionList m []) Just formals' -> defineName (funcName "foo") $ simpleDef "foo" $ A.Function m (A.PlainSpec,A.PlainRec) [A.Byte] formals' (Left $ A.Only m $ A.ExpressionList m [])
origProc = A.ProcCall m (procName "foo") params origProc = A.ProcCall m (procName "foo") params
expProc ps = A.ProcCall m (procName "foo") ps expProc ps = A.ProcCall m (procName "foo") ps
origFunc = A.FunctionCall m (funcName "foo") (deActualise params) origFunc = A.FunctionCall m (funcName "foo") (deActualise params)

View File

@ -60,10 +60,12 @@ assertGetItemCast k kv
-- | Given a body, returns a function spec: -- | Given a body, returns a function spec:
singleParamFunc :: A.Structured A.ExpressionList -> A.Specification singleParamFunc :: A.Structured A.ExpressionList -> A.Specification
singleParamFunc body = A.Specification m (simpleName "foo") (A.Function m A.PlainSpec [A.Int] [A.Formal A.ValAbbrev A.Byte (simpleName "param0")] (Left body)) singleParamFunc body = A.Specification m (simpleName "foo") (A.Function m (A.PlainSpec,
A.PlainRec) [A.Int] [A.Formal A.ValAbbrev A.Byte (simpleName "param0")] (Left body))
singleParamFuncProc :: A.Process -> A.Specification singleParamFuncProc :: A.Process -> A.Specification
singleParamFuncProc body = A.Specification m (simpleName "foo") (A.Function m A.PlainSpec [A.Int] [A.Formal A.ValAbbrev A.Byte (simpleName "param0")] (Right body)) singleParamFuncProc body = A.Specification m (simpleName "foo") (A.Function m (A.PlainSpec,
A.PlainRec) [A.Int] [A.Formal A.ValAbbrev A.Byte (simpleName "param0")] (Right body))
-- | Returns the expected body of the single parameter process (when the function had valof0 as a body) -- | Returns the expected body of the single parameter process (when the function had valof0 as a body)
singleParamBodyExp :: Pattern -- ^ to match: A.Process singleParamBodyExp :: Pattern -- ^ to match: A.Process
@ -97,7 +99,7 @@ testFunctionsToProcs0 = TestCase $ testPassWithItemsStateCheck "testFunctionsToP
testFunctionsToProcs1 :: Test testFunctionsToProcs1 :: Test
testFunctionsToProcs1 = TestCase $ testPassWithItemsStateCheck "testFunctionsToProcs1 A" exp functionsToProcs orig (return ()) check testFunctionsToProcs1 = TestCase $ testPassWithItemsStateCheck "testFunctionsToProcs1 A" exp functionsToProcs orig (return ()) check
where where
orig = A.Specification m (simpleName "foo") (A.Function m A.PlainSpec [A.Int,A.Real32] orig = A.Specification m (simpleName "foo") (A.Function m (A.PlainSpec, A.PlainRec) [A.Int,A.Real32]
[A.Formal A.ValAbbrev A.Byte (simpleName "param0"),A.Formal A.Abbrev A.Real32 (simpleName "param1")] (Left $ valofTwo "param0" "param1")) [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 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 [tag3 A.Formal A.ValAbbrev A.Byte (simpleName "param0"),
@ -130,7 +132,8 @@ testFunctionsToProcs1 = TestCase $ testPassWithItemsStateCheck "testFunctionsToP
testFunctionsToProcs2 :: Test testFunctionsToProcs2 :: Test
testFunctionsToProcs2 = TestCase $ testPassWithItemsStateCheck "testFunctionsToProcs2 A" exp functionsToProcs orig (return ()) check testFunctionsToProcs2 = TestCase $ testPassWithItemsStateCheck "testFunctionsToProcs2 A" exp functionsToProcs orig (return ()) check
where where
orig = A.Specification m (simpleName "fooOuter") (A.Function m A.PlainSpec [A.Int] [A.Formal A.ValAbbrev A.Byte (simpleName "paramOuter0")] $ Left $ orig = A.Specification m (simpleName "fooOuter") (A.Function m (A.PlainSpec,
A.PlainRec) [A.Int] [A.Formal A.ValAbbrev A.Byte (simpleName "paramOuter0")] $ Left $
A.Spec m (singleParamFunc valof0) valof0) A.Spec m (singleParamFunc valof0) valof0)
exp = tag3 A.Specification DontCare (simpleName "fooOuter") procBodyOuter 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 [tag3 A.Formal A.ValAbbrev A.Byte (simpleName "paramOuter0"), tag3 A.Formal A.Abbrev A.Int (Named "retOuter0" DontCare)] body
@ -184,7 +187,7 @@ testFunctionsToProcs3 = TestCase $ testPassWithItemsStateCheck "testFunctionsToP
testFunctionsToProcs4 :: Test testFunctionsToProcs4 :: Test
testFunctionsToProcs4 = TestCase $ testPassWithItemsStateCheck "testFunctionsToProcs4 A" exp functionsToProcs orig (return ()) check testFunctionsToProcs4 = TestCase $ testPassWithItemsStateCheck "testFunctionsToProcs4 A" exp functionsToProcs orig (return ()) check
where where
orig = A.Specification m (simpleName "foo") (A.Function m A.PlainSpec [A.Int,A.Real32] orig = A.Specification m (simpleName "foo") (A.Function m (A.PlainSpec, A.PlainRec) [A.Int,A.Real32]
[A.Formal A.ValAbbrev A.Byte (simpleName "param0"),A.Formal A.Abbrev A.Real32 (simpleName "param1")] $ [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"]) 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 exp = tag3 A.Specification DontCare (simpleName "foo") procBody