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

Fixed all the tests to reflect the new channel-end system, such that they all pass again

Browse Source 
This is the last patch (for now) of the set implementing the new channel-end system
This commit is contained in:
Neil Brown 2009-01-20 17:41:44 +00:00
parent 492091030d
commit 1f4796e07f
5 changed files with 142 additions and 120 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
backends/BackendPassesTest.hs
View File

@ -247,7 +247,7 @@ qcTestDeclareSizes =
strFooSizes = A.Spec emptyMeta (A.Specification emptyMeta (simpleName "foo_sizes") fooSizesSpec)
isChanArrFoo :: Int -> (A.SpecType, A.SpecType, State CompState ())
isChanArrFoo n = (A.IsChannelArray emptyMeta (A.Array [dimension n] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Byte) (replicate n $ variable "c")
isChanArrFoo n = (A.IsChannelArray emptyMeta (A.Array [dimension n] $ A.Chan (A.ChanAttributes False False) A.Byte) (replicate n $ variable "c")
,valSize [makeConstant emptyMeta n], return ())
isIsFoo :: ([A.Dimension], [A.Dimension], [A.Subscript]) -> (A.SpecType, A.SpecType, State CompState ())

128
backends/GenerateCTest.hs
View File

@ -255,40 +255,40 @@ testGenType = TestList
,testBothSame "GenType 252" "foo*" (tcall genType $ A.Mobile $ A.Record (simpleName "foo"))
,testBoth "GenType 253" "Time*" "csp::Time*" (tcall genType $ A.Mobile A.Time)
,testBoth "GenType 300" "Channel" "csp::One2OneChannel<int32_t>" (tcall genType $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int32)
,testBoth "GenType 301" "Channel" "csp::One2AnyChannel<int32_t>" (tcall genType $ A.Chan A.DirUnknown (A.ChanAttributes False True) A.Int32)
,testBoth "GenType 302" "Channel" "csp::Any2OneChannel<int32_t>" (tcall genType $ A.Chan A.DirUnknown (A.ChanAttributes True False) A.Int32)
,testBoth "GenType 303" "Channel" "csp::Any2AnyChannel<int32_t>" (tcall genType $ A.Chan A.DirUnknown (A.ChanAttributes True True) A.Int32)
,testBoth "GenType 300" "Channel" "csp::One2OneChannel<int32_t>" (tcall genType $ A.Chan (A.ChanAttributes False False) A.Int32)
,testBoth "GenType 301" "Channel" "csp::One2AnyChannel<int32_t>" (tcall genType $ A.Chan (A.ChanAttributes False True) A.Int32)
,testBoth "GenType 302" "Channel" "csp::Any2OneChannel<int32_t>" (tcall genType $ A.Chan (A.ChanAttributes True False) A.Int32)
,testBoth "GenType 303" "Channel" "csp::Any2AnyChannel<int32_t>" (tcall genType $ A.Chan (A.ChanAttributes True True) A.Int32)
,testBoth "GenType 310" "Channel" "csp::One2OneChannel<int32_t*>" (tcall genType $ A.Chan A.DirUnknown (A.ChanAttributes False False) (A.Mobile A.Int32))
,testBoth "GenType 310" "Channel" "csp::One2OneChannel<int32_t*>" (tcall genType $ A.Chan (A.ChanAttributes False False) (A.Mobile A.Int32))
,testBoth "GenType 400" "Channel*" "csp::Chanin<int32_t>" (tcall genType $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int32)
,testBoth "GenType 401" "Channel*" "csp::Chanin<int32_t>" (tcall genType $ A.Chan A.DirInput (A.ChanAttributes False True) A.Int32)
,testBoth "GenType 400" "Channel*" "csp::Chanin<int32_t>" (tcall genType $ A.ChanEnd A.DirInput (A.ChanAttributes False False) A.Int32)
,testBoth "GenType 401" "Channel*" "csp::Chanin<int32_t>" (tcall genType $ A.ChanEnd A.DirInput (A.ChanAttributes False True) A.Int32)
,testBoth "GenType 402" "Channel*" "csp::Chanout<int32_t>" (tcall genType $ A.Chan A.DirOutput (A.ChanAttributes False False) A.Int32)
,testBoth "GenType 403" "Channel*" "csp::Chanout<int32_t>" (tcall genType $ A.Chan A.DirOutput (A.ChanAttributes True False) A.Int32)
,testBoth "GenType 402" "Channel*" "csp::Chanout<int32_t>" (tcall genType $ A.ChanEnd A.DirOutput (A.ChanAttributes False False) A.Int32)
,testBoth "GenType 403" "Channel*" "csp::Chanout<int32_t>" (tcall genType $ A.ChanEnd A.DirOutput (A.ChanAttributes True False) A.Int32)
--ANY and protocols cannot occur outside channels in C++ or C, they are tested here:
,testBothFail "GenType 500" (tcall genType $ A.Any)
,testBothFail "GenType 600" (tcall genType $ A.UserProtocol (simpleName "foo"))
,testBothFail "GenType 650" (tcall genType $ A.Counted A.Int32 A.Int32)
,testBoth "GenType 700" "Channel**" "csp::One2OneChannel<int32_t>**" (tcall genType $ A.Array [dimension 5] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int32)
,testBoth "GenType 701" "Channel**" "csp::Chanin<int32_t>*" (tcall genType $ A.Array [dimension 5] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int32)
,testBoth "GenType 700" "Channel**" "csp::One2OneChannel<int32_t>**" (tcall genType $ A.Array [dimension 5] $ A.Chan (A.ChanAttributes False False) A.Int32)
,testBoth "GenType 701" "Channel**" "csp::Chanin<int32_t>*" (tcall genType $ A.Array [dimension 5] $ A.ChanEnd A.DirInput (A.ChanAttributes False False) A.Int32)
--Test types that can only occur inside channels:
--ANY:
,testBoth "GenType 800" "Channel" "csp::One2OneChannel<tockSendableArrayOfBytes>" (tcall genType $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Any)
,testBoth "GenType 800" "Channel" "csp::One2OneChannel<tockSendableArrayOfBytes>" (tcall genType $ A.Chan (A.ChanAttributes False False) A.Any)
--Protocol:
,testBoth "GenType 900" "Channel" "csp::One2OneChannel<tockSendableArrayOfBytes>" (tcall genType $ A.Chan A.DirUnknown (A.ChanAttributes False False) $ A.UserProtocol (simpleName "foo"))
,testBoth "GenType 900" "Channel" "csp::One2OneChannel<tockSendableArrayOfBytes>" (tcall genType $ A.Chan (A.ChanAttributes False False) $ A.UserProtocol (simpleName "foo"))
--Counted:
,testBoth "GenType 1000" "Channel" "csp::One2OneChannel<tockSendableArrayOfBytes>" (tcall genType $ A.Chan A.DirUnknown (A.ChanAttributes False False) $ A.Counted A.Int32 A.Int32)
,testBoth "GenType 1000" "Channel" "csp::One2OneChannel<tockSendableArrayOfBytes>" (tcall genType $ A.Chan (A.ChanAttributes False False) $ A.Counted A.Int32 A.Int32)
--Channels of arrays are special in C++:
,testBoth "GenType 1100" "Channel" "csp::One2OneChannel<tockSendableArray<int32_t,6>>"
(tcall genType $ A.Chan A.DirUnknown (A.ChanAttributes False False) $ A.Array [dimension 6] A.Int32)
(tcall genType $ A.Chan (A.ChanAttributes False False) $ A.Array [dimension 6] A.Int32)
,testBoth "GenType 1101" "Channel" "csp::One2OneChannel<tockSendableArray<int32_t,6*7*8>>"
(tcall genType $ A.Chan A.DirUnknown (A.ChanAttributes False False) $ A.Array [dimension 6,dimension 7,dimension 8] A.Int32)
(tcall genType $ A.Chan (A.ChanAttributes False False) $ A.Array [dimension 6,dimension 7,dimension 8] A.Int32)
-- List types:
@ -463,14 +463,14 @@ testDeclaration = TestList
testBothSame "genDeclaration 0" "int32_t foo;" (tcall3 genDeclaration A.Int32 foo False)
--Channels and channel-ends:
,testBoth "genDeclaration 1" "Channel foo;" "csp::One2OneChannel<int32_t> foo;" (tcall3 genDeclaration (A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int32) foo False)
,testBoth "genDeclaration 2" "Channel foo;" "csp::Any2OneChannel<int32_t> foo;" (tcall3 genDeclaration (A.Chan A.DirUnknown (A.ChanAttributes True False) A.Int32) foo False)
,testBoth "genDeclaration 3" "Channel foo;" "csp::One2AnyChannel<int32_t> foo;" (tcall3 genDeclaration (A.Chan A.DirUnknown (A.ChanAttributes False True) A.Int32) foo False)
,testBoth "genDeclaration 4" "Channel foo;" "csp::Any2AnyChannel<int32_t> foo;" (tcall3 genDeclaration (A.Chan A.DirUnknown (A.ChanAttributes True True) A.Int32) foo False)
,testBoth "genDeclaration 5" "Channel* foo;" "csp::Chanin<int32_t> foo;" (tcall3 genDeclaration (A.Chan A.DirInput (A.ChanAttributes False False) A.Int32) foo False)
,testBoth "genDeclaration 6" "Channel* foo;" "csp::Chanin<int32_t> foo;" (tcall3 genDeclaration (A.Chan A.DirInput (A.ChanAttributes False True) A.Int32) foo False)
,testBoth "genDeclaration 7" "Channel* foo;" "csp::Chanout<int32_t> foo;" (tcall3 genDeclaration (A.Chan A.DirOutput (A.ChanAttributes False False) A.Int32) foo False)
,testBoth "genDeclaration 8" "Channel* foo;" "csp::Chanout<int32_t> foo;" (tcall3 genDeclaration (A.Chan A.DirOutput (A.ChanAttributes True False) A.Int32) foo False)
,testBoth "genDeclaration 1" "Channel foo;" "csp::One2OneChannel<int32_t> foo;" (tcall3 genDeclaration (A.Chan (A.ChanAttributes False False) A.Int32) foo False)
,testBoth "genDeclaration 2" "Channel foo;" "csp::Any2OneChannel<int32_t> foo;" (tcall3 genDeclaration (A.Chan (A.ChanAttributes True False) A.Int32) foo False)
,testBoth "genDeclaration 3" "Channel foo;" "csp::One2AnyChannel<int32_t> foo;" (tcall3 genDeclaration (A.Chan (A.ChanAttributes False True) A.Int32) foo False)
,testBoth "genDeclaration 4" "Channel foo;" "csp::Any2AnyChannel<int32_t> foo;" (tcall3 genDeclaration (A.Chan (A.ChanAttributes True True) A.Int32) foo False)
,testBoth "genDeclaration 5" "Channel* foo;" "csp::Chanin<int32_t> foo;" (tcall3 genDeclaration (A.ChanEnd A.DirInput (A.ChanAttributes False False) A.Int32) foo False)
,testBoth "genDeclaration 6" "Channel* foo;" "csp::Chanin<int32_t> foo;" (tcall3 genDeclaration (A.ChanEnd A.DirInput (A.ChanAttributes False True) A.Int32) foo False)
,testBoth "genDeclaration 7" "Channel* foo;" "csp::Chanout<int32_t> foo;" (tcall3 genDeclaration (A.ChanEnd A.DirOutput (A.ChanAttributes False False) A.Int32) foo False)
,testBoth "genDeclaration 8" "Channel* foo;" "csp::Chanout<int32_t> foo;" (tcall3 genDeclaration (A.ChanEnd A.DirOutput (A.ChanAttributes True False) A.Int32) foo False)
--Arrays (of simple):
,testBothSame "genDeclaration 100" "int32_t foo[8];"
@ -491,19 +491,19 @@ testDeclaration = TestList
--Arrays of channels and channel-ends:
,testBoth "genDeclaration 200" "Channel foo_storage[8];Channel* foo[8];"
"csp::One2OneChannel<int32_t> foo_storage[8];csp::One2OneChannel<int32_t>* foo[8];"
(tcall3 genDeclaration (A.Array [dimension 8] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int32) foo False)
(tcall3 genDeclaration (A.Array [dimension 8] $ A.Chan (A.ChanAttributes False False) A.Int32) foo False)
,testBoth "genDeclaration 201" "Channel foo_storage[8*9];Channel* foo[8*9];"
"csp::One2OneChannel<int32_t> foo_storage[8*9];csp::One2OneChannel<int32_t>* foo[8*9];"
(tcall3 genDeclaration (A.Array [dimension 8, dimension 9] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int32) foo False)
(tcall3 genDeclaration (A.Array [dimension 8, dimension 9] $ A.Chan (A.ChanAttributes False False) A.Int32) foo False)
,testBoth "genDeclaration 202" "Channel* foo[8];"
"csp::Chanin<int32_t> foo[8];"
(tcall3 genDeclaration (A.Array [dimension 8] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int32) foo False)
(tcall3 genDeclaration (A.Array [dimension 8] $ A.ChanEnd A.DirInput (A.ChanAttributes False False) A.Int32) foo False)
,testBoth "genDeclaration 203" "Channel* foo[8*9];"
"csp::Chanout<int32_t> foo[8*9];"
(tcall3 genDeclaration (A.Array [dimension 8, dimension 9] $ A.Chan A.DirOutput (A.ChanAttributes False False) A.Int32) foo False)
(tcall3 genDeclaration (A.Array [dimension 8, dimension 9] $ A.ChanEnd A.DirOutput (A.ChanAttributes False False) A.Int32) foo False)
--Records of simple:
@ -528,15 +528,15 @@ testDeclareInitFree = TestLabel "testDeclareInitFree" $ TestList
testAllSame 0 ("","") A.Int
-- Channel types:
,testAll 1 ("ChanInit(wptr,(&foo));","") ("","") $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int
,testAllSame 2 ("","") $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int
,testAll 1 ("ChanInit(wptr,(&foo));","") ("","") $ A.Chan (A.ChanAttributes False False) A.Int
,testAllSame 2 ("","") $ A.ChanEnd A.DirInput (A.ChanAttributes False False) A.Int
-- Plain arrays:
,testAllSame 3 ("","") $ A.Array [dimension 4] A.Int
-- Channel arrays:
,testAll 4 ("tock_init_chan_array(foo_storage,foo,4);^ChanInit(wptr,foo[0]);^","") ("tockInitChanArray(foo_storage,foo,4);","") $ A.Array [dimension 4] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int
,testAllSame 6 ("","") $ A.Array [dimension 4] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int
,testAll 4 ("tock_init_chan_array(foo_storage,foo,4);^ChanInit(wptr,foo[0]);^","") ("tockInitChanArray(foo_storage,foo,4);","") $ A.Array [dimension 4] $ A.Chan (A.ChanAttributes False False) A.Int
,testAllSame 6 ("","") $ A.Array [dimension 4] $ A.ChanEnd A.DirInput (A.ChanAttributes False False) A.Int
-- Plain records:
,testAllR 100 ("","") ("","") A.Int id
@ -547,7 +547,7 @@ testDeclareInitFree = TestLabel "testDeclareInitFree" $ TestList
-- Mobile versions
,testAllSame 1003 ("","") $ A.Mobile $ A.Array [dimension 4] A.Int
,testAllSame 1004 ("","") $ A.Mobile $ A.Array [dimension 4] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int
,testAllSame 1004 ("","") $ A.Mobile $ A.Array [dimension 4] $ A.Chan (A.ChanAttributes False False) A.Int
,testAllR 1100 ("","") ("","") A.Int A.Mobile
-- Records containing an array:
,testAllR 1101 ("","") ("","") (A.Array [dimension 4,dimension 5] A.Int) A.Mobile
@ -611,9 +611,9 @@ testSpec = TestList
[
--Declaration:
testAllSame 0 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta A.Int
,testAllSame 1 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta (A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int)
,testAllSame 1 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta (A.Chan (A.ChanAttributes False False) A.Int)
,testAllSame 2 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta (A.Array [dimension 3] A.Int)
,testAllSame 3 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta (A.Array [dimension 3] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int)
,testAllSame 3 ("#ATION_False#INIT","#FREE") $ A.Declaration emptyMeta (A.Array [dimension 3] $ A.Chan (A.ChanAttributes False False) A.Int)
-- TODO test declarations with initialisers
@ -666,8 +666,8 @@ testSpec = TestList
-- Channel retyping doesn't require size checking:
,testAllS 1000 ("Channel*const foo=(Channel*const)(&y);","") ("csp::One2OneChannel<tockSendableArrayOfBytes>*const foo=(csp::One2OneChannel<tockSendableArrayOfBytes>*const)(&y);","")
(A.Retypes emptyMeta A.Abbrev (A.Chan A.DirUnknown (A.ChanAttributes False False) A.Any) (variable "y"))
(defineName (simpleName "y") (simpleDefDecl "y" (A.Chan A.DirUnknown (A.ChanAttributes False False) A.Any))) id
(A.Retypes emptyMeta A.Abbrev (A.Chan (A.ChanAttributes False False) A.Any) (variable "y"))
(defineName (simpleName "y") (simpleDefDecl "y" (A.Chan (A.ChanAttributes False False) A.Any))) id
-- Plain-to-array retyping:
-- single (unknown) dimension:
@ -708,9 +708,9 @@ testSpec = TestList
testAllForTypes :: Int -> (A.Type -> (String, String)) -> (A.Type -> (String, String)) -> (A.Type -> A.SpecType) -> [A.Type] -> Test
testAllForTypes n teC teCPP spec ts = TestList [testAllS (n+i) (teC t) (teCPP t) (spec t) (defineName (simpleName "bar") $ simpleDefDecl "bar" t) over' | (i,t) <- zip [0..] ts]
chanInt = A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int
chanIntIn = A.Chan A.DirInput (A.ChanAttributes False False) A.Int
chanIntOut = A.Chan A.DirOutput (A.ChanAttributes False False) A.Int
chanInt = A.Chan (A.ChanAttributes False False) A.Int
chanIntIn = A.ChanEnd A.DirInput (A.ChanAttributes False False) A.Int
chanIntOut = A.ChanEnd A.DirOutput (A.ChanAttributes False False) A.Int
testAll :: Int -> (String,String) -> (String,String) -> A.SpecType -> Test
testAll a b c d = testAllS a b c d (return ()) over
@ -732,7 +732,7 @@ testRetypeSizes :: Test
testRetypeSizes = TestList
[
-- Channel retyping doesn't need size check:
test 0 "" (A.Chan undefined undefined undefined) (A.Chan undefined undefined undefined)
test 0 "" (A.Chan undefined undefined) (A.Chan undefined undefined)
-- Plain types just need to check the return of occam_check_retype:
,test 1 "if(occam_check_retype(#S,#D,#M)!=1){@}"
@ -780,8 +780,8 @@ testGenVariable = TestList
-- Various types, unsubscripted:
testSameA 0 ("foo","(*foo)","foo") id A.Int
,testSameA 10 ("(&foo)","foo","foo") id (A.Record bar)
,testSameA2 20 ("(&foo)","foo") id (A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int)
,testSameA2 30 ("foo","foo") id (A.Chan A.DirInput (A.ChanAttributes False False) A.Int)
,testSameA2 20 ("(&foo)","foo") id (A.Chan (A.ChanAttributes False False) A.Int)
,testSameA2 30 ("foo","foo") id (A.ChanEnd A.DirInput (A.ChanAttributes False False) A.Int)
-- Mobile versions of the above:
,testSameA2 40 ("foo","(*foo)") id (A.Mobile A.Int)
@ -792,8 +792,8 @@ testGenVariable = TestList
-- Arrays of the previous types, unsubscripted:
,testSameA 100 ("foo","foo","foo") id (A.Array [dimension 8] A.Int)
,testSameA 110 ("foo","foo","foo") id (A.Array [dimension 8] $ A.Record bar)
,testSameA2 120 ("foo","foo") id (A.Array [dimension 8] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int)
,testSameA2 130 ("foo","foo") id (A.Array [dimension 8] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int)
,testSameA2 120 ("foo","foo") id (A.Array [dimension 8] $ A.Chan (A.ChanAttributes False False) A.Int)
,testSameA2 130 ("foo","foo") id (A.Array [dimension 8] $ A.ChanEnd A.DirInput (A.ChanAttributes False False) A.Int)
-- Mobile arrays of the previous types:
,testSameA2 140 ("foo","(*foo)") id (A.Mobile $ A.Array [dimension 8] A.Int)
@ -813,8 +813,8 @@ testGenVariable = TestList
,testAC 305 ("foo@C4,5,6","foo@U4,5,6") ((sub 6) . (sub 5) . (sub 4)) (A.Array [dimension 8,dimension 9,dimension 10] A.Int)
,testAC 310 ("(&foo@C4)","(&foo@U4)") (sub 4) (A.Array [dimension 8] $ A.Record bar)
-- Original channel arrays are Channel*[], abbreviated channel arrays are Channel*[]:
,testAC2 320 ("foo@C4","foo@U4") ("foo@C4","foo@U4") (sub 4) (A.Array [dimension 8] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int)
,testAC 330 ("foo@C4","foo@U4") (sub 4) (A.Array [dimension 8] $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int)
,testAC2 320 ("foo@C4","foo@U4") ("foo@C4","foo@U4") (sub 4) (A.Array [dimension 8] $ A.Chan (A.ChanAttributes False False) A.Int)
,testAC 330 ("foo@C4","foo@U4") (sub 4) (A.Array [dimension 8] $ A.ChanEnd A.DirInput (A.ChanAttributes False False) A.Int)
-- Fully subscripted array, and record field reference:
,testAC 400 ("(&foo@C4)->x","(&foo@U4)->x") (fieldX . (sub 4)) (A.Array [dimension 8] $ A.Record bar)
@ -824,10 +824,10 @@ testGenVariable = TestList
--TODO come back to slices later
-- Directed variables (incl. members of arrays, deref mobiles):
,testSameA2 500 ("$(&foo)$","$foo$") dir (A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int)
,testSameA2 500 ("$(&foo)$","$foo$") dir (A.Chan (A.ChanAttributes False False) A.Int)
-- Test for mobile channels (in future)
--,testSameA2 510 ("$foo$","$(*foo)$") (dir . deref) (A.Mobile $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int)
,testAC2 520 ("$foo@C4$","$foo@U4$") ("$foo@C4$","$foo@U4$") (dir . (sub 4)) (A.Array [dimension 8] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int)
,testAC2 520 ("$foo@C4$","$foo@U4$") ("$foo@C4$","$foo@U4$") (dir . (sub 4)) (A.Array [dimension 8] $ A.Chan (A.ChanAttributes False False) A.Int)
]
where
deref = A.DerefVariable emptyMeta
@ -850,7 +850,7 @@ testGenVariable = TestList
defRecord "barbar" "y" $ A.Record bar
over :: Override
over = local $ \ops -> ops {genArraySubscript = (\c _ subs -> at >> (tell [if c /= A.NoCheck then "C" else "U"]) >> (seqComma $ map snd subs))
,genDirectedVariable = (\cg _ -> dollar >> cg >> dollar)}
,genDirectedVariable = (\_ _ cg _ -> dollar >> cg >> dollar)}
testA :: Int -> (String,String) -> (String,String) -> (A.Variable -> A.Variable) -> A.Type -> Test
testA n eC eCPP sub t = TestList [test n eC eCPP sub A.Original t, test (n+1) eC eCPP sub A.Abbrev t, test (n+2) eC eCPP sub A.ValAbbrev t]
@ -878,7 +878,7 @@ testAssign = TestList
testBothSameS "testAssign 0" "@=$;" (over (tcall3 genAssign emptyMeta [A.Variable emptyMeta foo] (A.ExpressionList emptyMeta [e]))) (state A.Int)
,testBothSameS "testAssign 1" "@=$;" (over (tcall3 genAssign emptyMeta [A.Variable emptyMeta foo] (A.ExpressionList emptyMeta [e]))) (state A.Time)
,testBothSameS "testAssign 2" "@=$;" (over (tcall3 genAssign emptyMeta [A.Variable emptyMeta foo] (A.ExpressionList emptyMeta [e])))
(state $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int)
(state $ A.ChanEnd A.DirInput (A.ChanAttributes False False) A.Int)
-- Fail because genAssign only handles one destination and one source:
,testBothFail "testAssign 100" (tcall3 genAssign emptyMeta [A.Variable emptyMeta foo,A.Variable emptyMeta foo] (A.ExpressionList emptyMeta [e]))
@ -887,7 +887,7 @@ testAssign = TestList
-- Fail because assignment can't be done with these types (should have already been transformed away):
,testBothFailS "testAssign 200" (over (tcall3 genAssign emptyMeta [A.Variable emptyMeta foo] (A.ExpressionList emptyMeta [e])))
(state $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int)
(state $ A.Chan (A.ChanAttributes False False) A.Int)
,testBothFailS "testAssign 201" (over (tcall3 genAssign emptyMeta [A.Variable emptyMeta foo] (A.ExpressionList emptyMeta [e])))
(state $ A.Record bar)
]
@ -1023,13 +1023,15 @@ 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)) (state A.DirUnknown)
,testBothS ("testInput [in] " ++ show n) (hashIs "c" eC) (hashIs "c" eCPP) (over (tcall2 genInputItem (A.Variable emptyMeta $ simpleName "c") ii)) (state A.DirInput)
testBothS ("testInput " ++ show n) (hashIs "(&c)" eC) (hashIs "(&c)->reader()" eCPP) (over (tcall2 genInputItem (A.Variable emptyMeta $ simpleName "c") ii))
(state $ A.Chan)
,testBothS ("testInput [in] " ++ show n) (hashIs "c" eC) (hashIs "c" eCPP) (over (tcall2 genInputItem (A.Variable emptyMeta $ simpleName "c") ii))
(state $ A.ChanEnd A.DirInput)
]
where
hashIs x y = subRegex (mkRegex "#") y x
state dir = do defineName (simpleName "c") $ simpleDefDecl "c" (A.Chan dir (A.ChanAttributes False False) ct)
state ch = do defineName (simpleName "c") $ simpleDefDecl "c" (ch (A.ChanAttributes False False) ct)
case t of
A.Counted t t' -> do defineName (simpleName "x") $ simpleDefDecl "x" t
defineName (simpleName "xs") $ simpleDefDecl "xs" (mkArray t')
@ -1141,13 +1143,15 @@ testOutput = TestList
testOutputItem' :: Int -> String -> String -> A.OutputItem -> A.Type -> A.Type -> Test
testOutputItem' n eC eCPP oi t ct = TestList
[
testBothS ("testOutput " ++ show n) (hashIs "(&c)" eC) (hashIs "(&c)->writer()" eCPP) (over (tcall2 genOutputItem (A.Variable emptyMeta $ simpleName "c") oi)) (state A.DirUnknown)
,testBothS ("testOutput [out] " ++ show n) (hashIs "c" eC) (hashIs "c" eCPP) (over (tcall2 genOutputItem (A.Variable emptyMeta $ simpleName "c") oi)) (state A.DirOutput)
testBothS ("testOutput " ++ show n) (hashIs "(&c)" eC) (hashIs "(&c)->writer()" eCPP) (over (tcall2 genOutputItem (A.Variable emptyMeta $ simpleName "c") oi))
(state $ A.Chan)
,testBothS ("testOutput [out] " ++ show n) (hashIs "c" eC) (hashIs "c" eCPP) (over (tcall2 genOutputItem (A.Variable emptyMeta $ simpleName "c") oi))
(state $ A.ChanEnd A.DirOutput)
]
where
hashIs x y = subRegex (mkRegex "#") y x
state dir = do defineName (simpleName "c") $ simpleDefDecl "c" (A.Chan dir (A.ChanAttributes False False) ct)
state ch = do defineName (simpleName "c") $ simpleDefDecl "c" (ch (A.ChanAttributes False False) ct)
case t of
A.Counted t t' -> do defineName (simpleName "x") $ simpleDefDecl "x" t
defineName (simpleName "xs") $ simpleDefDecl "xs" (mkArray t')
@ -1158,8 +1162,8 @@ testOutput = TestList
chan = simpleName "c"
chanOut = simpleName "cOut"
state :: CSM m => m ()
state = do defineName chan $ simpleDefDecl "c" (A.Chan A.DirUnknown (A.ChanAttributes False False) $ A.UserProtocol foo)
defineName chanOut $ simpleDefDecl "cOut" (A.Chan A.DirOutput (A.ChanAttributes False False) $ A.UserProtocol foo)
state = do defineName chan $ simpleDefDecl "c" (A.Chan (A.ChanAttributes False False) $ A.UserProtocol foo)
defineName chanOut $ simpleDefDecl "cOut" (A.ChanEnd A.DirOutput (A.ChanAttributes False False) $ A.UserProtocol foo)
overOutput, overOutputItem, over :: Override
overOutput = local $ \ops -> ops {genOutput = override2 caret}
overOutputItem = local $ \ops -> ops {genOutputItem = override2 caret}
@ -1170,8 +1174,8 @@ testBytesIn = TestList
[
testBothSame "testBytesIn 0" "sizeof(int8_t)" (tcall3 genBytesIn undefined A.Int8 undefined)
,testBothSame "testBytesIn 1" "sizeof(foo)" (tcall3 genBytesIn undefined (A.Record foo) undefined)
,testBoth "testBytesIn 2" "sizeof(Channel)" "sizeof(csp::One2OneChannel<int32_t>)" (tcall3 genBytesIn undefined (A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int32) undefined)
,testBoth "testBytesIn 3" "sizeof(Channel*)" "sizeof(csp::Chanin<int64_t>)" (tcall3 genBytesIn undefined (A.Chan A.DirInput (A.ChanAttributes False False) A.Int64) undefined)
,testBoth "testBytesIn 2" "sizeof(Channel)" "sizeof(csp::One2OneChannel<int32_t>)" (tcall3 genBytesIn undefined (A.Chan (A.ChanAttributes False False) A.Int32) undefined)
,testBoth "testBytesIn 3" "sizeof(Channel*)" "sizeof(csp::Chanin<int64_t>)" (tcall3 genBytesIn undefined (A.ChanEnd A.DirInput (A.ChanAttributes False False) A.Int64) undefined)
--Array with a single known dimension:
,testBothSame "testBytesIn 100" "5*sizeof(int16_t)" (tcall3 genBytesIn undefined (A.Array [dimension 5] A.Int16) (Left False))

106
frontends/OccamTypesTest.hs
View File

@ -74,7 +74,7 @@ startState
where
intsT = A.Array [A.UnknownDimension] A.Int
arrayLit = A.ArrayLiteral m []
chanT t = A.Chan A.DirUnknown (A.ChanAttributes False False) t
chanT t = A.Chan (A.ChanAttributes False False) t
chanIntT = chanT A.Int
countedIntsT = chanT $ A.UserProtocol (simpleName "countedInts")
iirT = chanT $ A.UserProtocol (simpleName "iir")
@ -212,71 +212,81 @@ testOccamTypes = TestList
--{{{ processes
-- Inputs
, testOK 1000 $ inputSimple countedIntsC [A.InCounted m intV intsV]
, testFail 1001 $ inputSimple countedIntsC [A.InCounted m realV intsV]
, testFail 1002 $ inputSimple countedIntsC [A.InCounted m intV intV]
, testFail 1003 $ inputSimple countedIntsC [A.InCounted m constIntV intsV]
, testFail 1004 $ inputSimple countedIntsC [A.InCounted m intV constIntsV]
, testFail 1005 $ inputSimple countedIntsC [A.InCounted m intV intsC]
, testOK 1010 $ inputSimple intC [inv intV]
, testFail 1011 $ inputSimple intC [inv constIntV]
, testFail 1012 $ inputSimple intC [inv intC]
, testOK 1000 $ inputSimple countedIntsCin [A.InCounted m intV intsV]
, testFail 1001 $ inputSimple countedIntsCin [A.InCounted m realV intsV]
, testFail 1002 $ inputSimple countedIntsCin [A.InCounted m intV intV]
, testFail 1003 $ inputSimple countedIntsCin [A.InCounted m constIntV intsV]
, testFail 1004 $ inputSimple countedIntsCin [A.InCounted m intV constIntsV]
, testFail 1005 $ inputSimple countedIntsCin [A.InCounted m intV intsC]
, testOK 1010 $ inputSimple intCin [inv intV]
, testFail 1011 $ inputSimple intCin [inv constIntV]
, testFail 1012 $ inputSimple intCin [inv intC]
, testFail 1013 $ inputSimple intV [inv intV]
, testFail 1014 $ inputSimple intV []
, testFail 1015 $ inputSimple intV [inv intV, inv intV]
, testFail 1016 $ inputSimple tim [inv intV]
, testOK 1020 $ inputSimple iirC [inv intV, inv intV, inv realV]
, testFail 1021 $ inputSimple iirC [inv intV, inv realV, inv intV]
, testFail 1022 $ inputSimple iirC [inv realV, inv intV, inv intV]
, testFail 1023 $ inputSimple iirC [inv intV, inv intV]
, testFail 1024 $ inputSimple iirC [inv intV, inv intV, inv realV, inv intV]
, testOK 1030 $ inputCase caseC [ vari "one" [inv intV]
, testFail 1017 $ inputSimple intC [inv intV]
, testOK 1020 $ inputSimple iirCin [inv intV, inv intV, inv realV]
, testFail 1021 $ inputSimple iirCin [inv intV, inv realV, inv intV]
, testFail 1022 $ inputSimple iirCin [inv realV, inv intV, inv intV]
, testFail 1023 $ inputSimple iirCin [inv intV, inv intV]
, testFail 1024 $ inputSimple iirCin [inv intV, inv intV, inv realV, inv intV]
, testOK 1030 $ inputCase caseCin [ vari "one" [inv intV]
, vari "two" [inv realV]
, vari "three" []
]
, testFail 1031 $ inputCase caseC [ vari "one" [inv realV]
, testFail 1031 $ inputCase caseCin [ vari "one" [inv realV]
, vari "two" [inv realV]
, vari "three" []
]
, testFail 1032 $ inputCase caseC [ vari "one" [inv intV]
, testFail 1032 $ inputCase caseCin [ vari "one" [inv intV]
, vari "two" [inv intV]
, vari "three" []
]
, testFail 1033 $ inputCase caseC [ vari "one" [inv intV]
, testFail 1033 $ inputCase caseCin [ vari "one" [inv intV]
, vari "herring" [inv realV]
, vari "three" []
]
, testFail 1034 $ inputCase caseC [ vari "one" [inv intV, inv realV]
, testFail 1034 $ inputCase caseCin [ vari "one" [inv intV, inv realV]
, vari "two" [inv realV]
, vari "three" []
]
, testFail 1035 $ inputCase caseC [ vari "one" []
, testFail 1035 $ inputCase caseCin [ vari "one" []
, vari "two" []
, vari "three" []
]
, testFail 1036 $ inputCase caseC [ vari "one" [inv intV]
, vari "two" [inv realV]
, vari "three" []
]
-- Outputs
, testOK 1100 $ outputSimple countedIntsC [A.OutCounted m intE twoIntsE]
, testFail 1101 $ outputSimple countedIntsC [A.OutCounted m realE twoIntsE]
, testFail 1102 $ outputSimple countedIntsC [A.OutCounted m intE intE]
, testOK 1110 $ outputSimple intC [oute intE]
, testFail 1111 $ outputSimple intC [oute intCE]
, testOK 1100 $ outputSimple countedIntsCout [A.OutCounted m intE twoIntsE]
, testFail 1101 $ outputSimple countedIntsCout [A.OutCounted m realE twoIntsE]
, testFail 1102 $ outputSimple countedIntsCout [A.OutCounted m intE intE]
, testFail 1103 $ outputSimple countedIntsC [A.OutCounted m intE twoIntsE]
, testOK 1110 $ outputSimple intCout [oute intE]
, testFail 1111 $ outputSimple intCout [oute intCE]
, testFail 1112 $ outputSimple intV [oute intE]
, testFail 1113 $ outputSimple tim [oute intE]
, testOK 1120 $ outputSimple iirC [oute intE, oute intE, oute realE]
, testFail 1121 $ outputSimple iirC [oute intE, oute realE, oute intE]
, testFail 1122 $ outputSimple iirC [oute realE, oute intE, oute intE]
, testFail 1123 $ outputSimple iirC [oute intE, oute intE]
, testFail 1124 $ outputSimple iirC [oute intE, oute intE, oute realE,
, testFail 1114 $ outputSimple intC [oute intE]
, testOK 1120 $ outputSimple iirCout [oute intE, oute intE, oute realE]
, testFail 1121 $ outputSimple iirCout [oute intE, oute realE, oute intE]
, testFail 1122 $ outputSimple iirCout [oute realE, oute intE, oute intE]
, testFail 1123 $ outputSimple iirCout [oute intE, oute intE]
, testFail 1124 $ outputSimple iirCout [oute intE, oute intE, oute realE,
oute intE]
, testOK 1130 $ outputCase caseC "one" [oute intE]
, testOK 1131 $ outputCase caseC "two" [oute realE]
, testOK 1132 $ outputCase caseC "three" []
, testFail 1133 $ outputCase caseC "three" [oute intE]
, testFail 1134 $ outputCase caseC "two" [oute realE, oute intE]
, testFail 1135 $ outputCase caseC "two" []
, testFail 1136 $ outputCase caseC "two" [oute intE]
, testFail 1137 $ outputCase caseC "herring" [oute intE]
, testFail 1125 $ outputSimple iirC [oute intE, oute intE, oute realE]
, testOK 1130 $ outputCase caseCout "one" [oute intE]
, testOK 1131 $ outputCase caseCout "two" [oute realE]
, testOK 1132 $ outputCase caseCout "three" []
, testFail 1133 $ outputCase caseCout "three" [oute intE]
, testFail 1134 $ outputCase caseCout "two" [oute realE, oute intE]
, testFail 1135 $ outputCase caseCout "two" []
, testFail 1136 $ outputCase caseCout "two" [oute intE]
, testFail 1137 $ outputCase caseCout "herring" [oute intE]
, testFail 1138 $ outputCase caseC "one" [oute intE]
-- Timer operations
, testOK 1180 $ A.Input m tim $ A.InputTimerRead m $ inv intV
@ -329,17 +339,17 @@ testOccamTypes = TestList
$ A.FunctionCallList m function22 [realE]
-- Alt
, testOK 1500 $ testAlt $ A.Alternative m true intC (insim [inv intV]) skip
, testOK 1500 $ testAlt $ A.Alternative m true intCin (insim [inv intV]) skip
, testOK 1501 $ testAlt $ A.Alternative m true tim
(A.InputTimerAfter m intE) skip
, testOK 1502 $ testAlt $ A.Alternative m boolE intC
, testOK 1502 $ testAlt $ A.Alternative m boolE intCin
(insim [inv intV]) skip
, testOK 1503 $ testAlt $ A.AlternativeSkip m boolE skip
, testFail 1504 $ testAlt $ A.Alternative m true intC (insim [inv realV]) skip
, testFail 1504 $ testAlt $ A.Alternative m true intCin (insim [inv realV]) skip
, testFail 1505 $ testAlt $ A.Alternative m true tim
(A.InputTimerRead m $ inv intV)
skip
, testFail 1506 $ testAlt $ A.Alternative m intE intC
, testFail 1506 $ testAlt $ A.Alternative m intE intCin
(insim [inv intV]) skip
, testFail 1507 $ testAlt $ A.AlternativeSkip m intE skip
@ -556,11 +566,13 @@ testOccamTypes = TestList
coord2E = A.Literal m coord2T coord2
coord3T = A.Record (simpleName "COORD3")
coord3 = A.RecordLiteral m [realE, realE, realE]
chanT t = A.Chan A.DirUnknown (A.ChanAttributes False False) t
chanT t = A.Chan (A.ChanAttributes False False) t
chanIntT = chanT A.Int
chansIntT = A.Array [dimension 2] $ chanT A.Int
uchansIntT = A.Array [A.UnknownDimension] $ chanT A.Int
intC = variable "chanInt"
intCin = A.DirectedVariable emptyMeta A.DirInput intC
intCout = A.DirectedVariable emptyMeta A.DirOutput intC
intCE = A.ExprVariable m intC
intsC = variable "chansInt"
mobileIntV = variable "mobileInt"
@ -576,8 +588,14 @@ testOccamTypes = TestList
listE = A.Literal m listT (A.ListLiteral m [intE, intE, intE])
i = simpleName "i"
countedIntsC = variable "chanCountedInts"
countedIntsCin = A.DirectedVariable emptyMeta A.DirInput countedIntsC
countedIntsCout = A.DirectedVariable emptyMeta A.DirOutput countedIntsC
iirC = variable "chanIIR"
iirCin = A.DirectedVariable emptyMeta A.DirInput iirC
iirCout = A.DirectedVariable emptyMeta A.DirOutput iirC
caseC = variable "chanCaseProto"
caseCin = A.DirectedVariable emptyMeta A.DirInput caseC
caseCout = A.DirectedVariable emptyMeta A.DirOutput caseC
--}}}
--{{{ process fragments

24
frontends/ParseRainTest.hs
View File

@ -200,11 +200,11 @@ testExprs =
,failE ("(uint8 : b) + uint8 : c")
,failE ("(uint8 : b) == uint8 : c")
,passE ("?uint8: ?c", 240, Cast (A.Chan A.DirInput nonShared A.Byte) $ DirVar A.DirInput "c")
,passE ("?uint8: ?c", 240, Cast (A.ChanEnd A.DirInput nonShared A.Byte) $ DirVar A.DirInput "c")
--Should parse:
,passE ("?c: ?c", 241, Cast (A.Chan A.DirInput nonShared $ A.UserDataType $ typeName "c") $ DirVar A.DirInput "c")
,passE ("?c: ?c : b", 242, Cast (A.Chan A.DirInput nonShared $ A.UserDataType $ typeName "c") $
Cast (A.Chan A.DirInput nonShared $ A.UserDataType $ typeName "c") $ Var "b")
,passE ("?c: ?c", 241, Cast (A.ChanEnd A.DirInput nonShared $ A.UserDataType $ typeName "c") $ DirVar A.DirInput "c")
,passE ("?c: ?c : b", 242, Cast (A.ChanEnd A.DirInput nonShared $ A.UserDataType $ typeName "c") $
Cast (A.ChanEnd A.DirInput nonShared $ A.UserDataType $ typeName "c") $ Var "b")
,failE ("?c:")
,failE (":?c")
@ -549,13 +549,13 @@ testDataType =
,pass ("int0",RP.dataType,assertEqual "testDataType 12" $ A.UserDataType $ typeName "int0")
,fail ("bool bool",RP.dataType)
,pass ("?int",RP.dataType,assertEqual "testDataType 102" $ A.Chan A.DirInput nonShared A.Int)
,pass ("! bool",RP.dataType,assertEqual "testDataType 103" $ A.Chan A.DirOutput nonShared A.Bool)
,pass ("?int",RP.dataType,assertEqual "testDataType 102" $ A.ChanEnd A.DirInput nonShared A.Int)
,pass ("! bool",RP.dataType,assertEqual "testDataType 103" $ A.ChanEnd A.DirOutput nonShared A.Bool)
--These types should succeed in the *parser* -- they would be thrown out further down the line:
,pass ("??int",RP.dataType,assertEqual "testDataType 104" $ A.Chan A.DirInput nonShared $ A.Chan A.DirInput nonShared A.Int)
,pass ("? ? int",RP.dataType,assertEqual "testDataType 105" $ A.Chan A.DirInput nonShared $ A.Chan A.DirInput nonShared A.Int)
,pass ("!!bool",RP.dataType,assertEqual "testDataType 106" $ A.Chan A.DirOutput nonShared $ A.Chan A.DirOutput nonShared A.Bool)
,pass ("?!bool",RP.dataType,assertEqual "testDataType 107" $ A.Chan A.DirInput nonShared $ A.Chan A.DirOutput nonShared A.Bool)
,pass ("??int",RP.dataType,assertEqual "testDataType 104" $ A.ChanEnd A.DirInput nonShared $ A.ChanEnd A.DirInput nonShared A.Int)
,pass ("? ? int",RP.dataType,assertEqual "testDataType 105" $ A.ChanEnd A.DirInput nonShared $ A.ChanEnd A.DirInput nonShared A.Int)
,pass ("!!bool",RP.dataType,assertEqual "testDataType 106" $ A.ChanEnd A.DirOutput nonShared $ A.ChanEnd A.DirOutput nonShared A.Bool)
,pass ("?!bool",RP.dataType,assertEqual "testDataType 107" $ A.ChanEnd A.DirInput nonShared $ A.ChanEnd A.DirOutput nonShared A.Bool)
,fail ("?",RP.dataType)
,fail ("!",RP.dataType)
@ -564,7 +564,7 @@ testDataType =
,fail ("bool!",RP.dataType)
,fail ("int?int",RP.dataType)
,pass ("channel bool",RP.dataType,assertEqual "testDataType 200" $ A.Chan A.DirUnknown nonShared A.Bool)
,pass ("channel bool",RP.dataType,assertEqual "testDataType 200" $ A.Chan nonShared A.Bool)
,pass ("time",RP.dataType,assertEqual "testDataType 300" A.Time)
,pass ("timer",RP.dataType,assertEqual "testDataType 301" $ A.UserDataType $ typeName "timer")
@ -583,7 +583,7 @@ testDecl =
[
passd ("bool: b;",0,pat $ A.Specification m (simpleName "b") $ A.Declaration m A.Bool)
,passd ("uint8: x;",1,pat $ A.Specification m (simpleName "x") $ A.Declaration m A.Byte)
,passd ("?bool: bc;",2,pat $ A.Specification m (simpleName "bc") $ A.Declaration m (A.Chan A.DirInput nonShared A.Bool))
,passd ("?bool: bc;",2,pat $ A.Specification m (simpleName "bc") $ A.Declaration m (A.ChanEnd A.DirInput nonShared A.Bool))
,passd ("a: b;",3,pat $ A.Specification m (simpleName "b") $ A.Declaration m (A.UserDataType $ A.Name m "a"))
,passd2 ("bool: b0,b1;",100,pat $ A.Specification m (simpleName "b0") $ A.Declaration m A.Bool,

2
transformations/PassTest.hs
View File

@ -532,7 +532,7 @@ testInputCase = TestList
decl' (simpleName "prot")
(A.ProtocolCase emptyMeta [(a0,[]),(b2,[A.Int,A.Int]),(c1,[A.Int])])
A.Original A.NameUser
. singleton . decl (return $ A.Chan A.DirUnknown (A.ChanAttributes False False)
. singleton . decl (return $ A.Chan (A.ChanAttributes False False)
(A.UserProtocol $ simpleName "prot")) oC . singleton
testTransformProtocolInput :: Test