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

Got the tests compiling again after the changes to the AST for extended rendezvous

Browse Source
This commit is contained in:
Neil Brown 2009-04-19 17:34:36 +00:00
parent d3f4bd587e
commit d29b5b67cf
6 changed files with 24 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
backends/GenerateCTest.hs
View File

@ -975,9 +975,9 @@ testInput :: Test
testInput = TestList
[
-- Test that genInput passes on the calls properly:
testBothSame "testInput 0" "" (overInputItemCase (tcall2 genInput undefined $ A.InputSimple undefined []))
,testBothSame "testInput 1" "^" (overInputItemCase (tcall2 genInput undefined $ A.InputSimple undefined [undefined]))
,testBothSame "testInput 2" "^^^" (overInputItemCase (tcall2 genInput undefined $ A.InputSimple undefined [undefined, undefined, undefined]))
testBothSame "testInput 0" "" (overInputItemCase (tcall2 genInput undefined $ A.InputSimple undefined [] Nothing))
,testBothSame "testInput 1" "^" (overInputItemCase (tcall2 genInput undefined $ A.InputSimple undefined [undefined] Nothing))
,testBothSame "testInput 2" "^^^" (overInputItemCase (tcall2 genInput undefined $ A.InputSimple undefined [undefined, undefined, undefined] Nothing))
-- Reading an integer (special case in the C backend):
,testInputItem 100 "ChanInInt(wptr,#,&x);" "tockRecvArrayOfBytes(#,tockSendableArrayOfBytes(^(Int),&x));"
@ -1043,9 +1043,9 @@ testInput = TestList
testInputItem' :: Int -> String -> String -> A.InputItem -> A.Type -> A.Type -> Test
testInputItem' n eC eCPP ii t ct = TestList
[
testBothS ("testInput " ++ show n) (hashIs "&c" eC) (hashIs "(c).reader()" eCPP) (over (tcall2 genInputItem (A.Variable emptyMeta $ simpleName "c") ii))
testBothS ("testInput " ++ show n) (hashIs "&c" eC) (hashIs "(c).reader()" eCPP) (over (tcall2 genInputItem (A.Variable emptyMeta $ simpleName "c") ii Nothing))
(state $ A.Chan (A.ChanAttributes A.Unshared A.Unshared))
,testBothS ("testInput [in] " ++ show n) (hashIs "c" eC) (hashIs "c" eCPP) (over (tcall2 genInputItem (A.Variable emptyMeta $ simpleName "c") ii))
,testBothS ("testInput [in] " ++ show n) (hashIs "c" eC) (hashIs "c" eCPP) (over (tcall2 genInputItem (A.Variable emptyMeta $ simpleName "c") ii Nothing))
(state $ A.ChanEnd A.DirInput A.Unshared)
]
where
@ -1068,7 +1068,7 @@ testInput = TestList
-- defineName chanOut $ simpleDefDecl "cIn" (A.Chan A.DirInput (A.ChanAttributes False False) $ A.UserProtocol foo)
overInputItemCase, over :: Override
overInputItemCase = local $ \ops -> ops {genInputItem = override2 caret}
overInputItemCase = local $ \ops -> ops {genInputItem = override3 caret}
over = local $ \ops -> ops {genBytesIn = (\_ t _ -> tell ["^(", showSimplerType t, ")"]) , genArraySubscript = override3 dollar}
-- | Show a type, simplifying how Dimensions are show.

6
checks/UsageCheckTest.hs
View File

@ -100,11 +100,11 @@ testGetVarProc = TestList (map doTest tests)
[A.OutCounted emptyMeta (A.ExprVariable emptyMeta vA) (A.ExprVariable emptyMeta vB)])
-- Test simple inputs:
,(500,[],[tvB],[tvC],A.Input emptyMeta vC (A.InputSimple emptyMeta [A.InVariable emptyMeta vB]))
,(500,[],[tvB],[tvC],A.Input emptyMeta vC (A.InputSimple emptyMeta [A.InVariable emptyMeta vB] Nothing))
,(501,[],[tvA,tvB],[tvC],A.Input emptyMeta vC
(A.InputSimple emptyMeta [A.InVariable emptyMeta vB,A.InVariable emptyMeta vA]))
(A.InputSimple emptyMeta [A.InVariable emptyMeta vB,A.InVariable emptyMeta vA] Nothing))
,(502,[],[tvA,tvB],[tvC],A.Input emptyMeta vC
(A.InputSimple emptyMeta [A.InCounted emptyMeta vA vB]))
(A.InputSimple emptyMeta [A.InCounted emptyMeta vA vB] Nothing))
]
-- This is a custom test because there's no instance of Data for Vars.

8
common/OccamEDSL.hs
View File

@ -211,7 +211,7 @@ inputCaseOption :: (Castable c A.Variant) => (A.Name, [ExpInp A.Variable], O A.P
inputCaseOption (n, is, p)
= do is' <- sequence $ map liftExpInp is
p' <- p
return $ makePlain $ A.Variant emptyMeta n (map (A.InVariable emptyMeta) is') p'
return $ makePlain $ A.Variant emptyMeta n (map (A.InVariable emptyMeta) is') p' Nothing
oCASEinput :: [O (A.Structured A.Variant)] -> O (A.Structured A.Variant)
@ -355,13 +355,13 @@ class CanBeInput a where
inputItem :: a -> A.InputMode
instance CanBeInput A.Variable where
inputItem v = A.InputSimple emptyMeta [A.InVariable emptyMeta v]
inputItem v = A.InputSimple emptyMeta [A.InVariable emptyMeta v] Nothing
instance CanBeInput [A.Variable] where
inputItem = A.InputSimple emptyMeta . map (A.InVariable emptyMeta)
inputItem = flip (A.InputSimple emptyMeta) Nothing . map (A.InVariable emptyMeta)
instance CanBeInput (A.Structured A.Variant) where
inputItem = A.InputCase emptyMeta
inputItem = A.InputCase emptyMeta A.InputCaseNormal
instance CanBeInput A.InputMode where
inputItem = id

2
flow/FlowGraphTest.hs
View File

@ -446,7 +446,7 @@ testAlt = TestLabel "testAlt" $ TestList
]
where
guard45 = A.AlternativeSkip m4 (A.True mU) sm5
guard67 = A.Alternative m6 (A.True mU) (variable "c") (A.InputSimple mU []) sm7
guard67 = A.Alternative m6 (A.True mU) (variable "c") (A.InputSimple mU [] Nothing) sm7
spec8, spec9 :: Data a => A.Structured a -> A.Structured a
spec8 = A.Spec mU (A.Specification m8 undefined undefined)

6
frontends/OccamTypesTest.hs
View File

@ -605,11 +605,11 @@ testOccamTypes = TestList
skip = A.Skip m
jskip = Just skip
sskip = A.Only m skip
insim iis = A.InputSimple m iis
insim iis = A.InputSimple m iis Nothing
inputSimple c iis = A.Input m c $ insim iis
inputCase c vs = A.Input m c
$ A.InputCase m (A.Several m (map (A.Only m) vs))
vari tag iis = A.Variant m (simpleName tag) iis skip
$ A.InputCase m A.InputCaseNormal (A.Several m (map (A.Only m) vs))
vari tag iis = A.Variant m (simpleName tag) iis skip Nothing
outputSimple c ois = A.Output m c ois
outputCase c tag ois = A.OutputCase m c (simpleName tag) ois
testRep n r = A.Seq m $ A.Spec m (A.Specification m n (A.Rep m r)) sskip

13
transformations/PassTest.hs
View File

@ -566,14 +566,14 @@ testTransformProtocolInput = TestList
,TestCase $ testPass "testTransformProtocolInput3"
(A.Alt emptyMeta True $ A.Only emptyMeta $ A.Alternative emptyMeta (A.True
emptyMeta) (variable "c") (A.InputSimple emptyMeta [ii0]) $
emptyMeta) (variable "c") (A.InputSimple emptyMeta [ii0] Nothing) $
A.Seq emptyMeta $ A.Several emptyMeta $ onlySingle ii1 : [A.Only emptyMeta $ A.Skip emptyMeta])
transformProtocolInput (A.Alt emptyMeta True $ A.Only emptyMeta $ altItems [ii0, ii1])
(return ())
,TestCase $ testPass "testTransformProtocolInput4"
(A.Alt emptyMeta False $ A.Only emptyMeta $ A.Alternative emptyMeta (A.True
emptyMeta) (variable "c") (A.InputSimple emptyMeta [ii0]) $
emptyMeta) (variable "c") (A.InputSimple emptyMeta [ii0] Nothing) $
A.Seq emptyMeta $ A.Several emptyMeta $ map onlySingle [ii1,ii2] ++ [A.Only emptyMeta $ A.Skip emptyMeta])
transformProtocolInput (A.Alt emptyMeta False $ A.Only emptyMeta $ altItems [ii0, ii1, ii2])
(return ())
@ -583,11 +583,12 @@ testTransformProtocolInput = TestList
ii1 = A.InCounted emptyMeta (variable "y") (variable "z")
ii2 = A.InVariable emptyMeta (variable "a")
onlySingle = A.Only emptyMeta . A.Input emptyMeta (variable "c") . A.InputSimple emptyMeta . singleton
onlySingle = A.Only emptyMeta . A.Input emptyMeta (variable "c") . flip (A.InputSimple emptyMeta) Nothing . singleton
onlySingleAlt = A.Only emptyMeta . flip (A.Alternative emptyMeta (A.True
emptyMeta) (variable "c")) (A.Skip emptyMeta) . A.InputSimple emptyMeta . singleton
seqItems = A.Input emptyMeta (variable "c") . A.InputSimple emptyMeta
altItems = flip (A.Alternative emptyMeta (A.True emptyMeta) (variable "c")) (A.Skip emptyMeta) . A.InputSimple emptyMeta
emptyMeta) (variable "c")) (A.Skip emptyMeta) . flip (A.InputSimple emptyMeta) Nothing . singleton
seqItems = A.Input emptyMeta (variable "c") . flip (A.InputSimple emptyMeta) Nothing
altItems = flip (A.Alternative emptyMeta (A.True emptyMeta) (variable "c")) (A.Skip emptyMeta)
. flip (A.InputSimple emptyMeta) Nothing
testPullRepCounts :: Test