Added tests for ProtocolCase in introduceSpec, and made the C++ version behave the same as the C version
This commit is contained in:
parent
03a4b8e41b
commit
97ee0c4a4e
|
@ -1336,15 +1336,14 @@ cintroduceSpec ops (A.Specification _ n (A.RecordType _ b fs))
|
||||||
tell [";"]
|
tell [";"]
|
||||||
cintroduceSpec _ (A.Specification _ n (A.Protocol _ _)) = return ()
|
cintroduceSpec _ (A.Specification _ n (A.Protocol _ _)) = return ()
|
||||||
cintroduceSpec ops (A.Specification _ n (A.ProtocolCase _ ts))
|
cintroduceSpec ops (A.Specification _ n (A.ProtocolCase _ ts))
|
||||||
= do tell ["typedef enum {\n"]
|
= do tell ["typedef enum{"]
|
||||||
seqComma [genName tag >> tell ["_"] >> genName n | (tag, _) <- ts]
|
seqComma [genName tag >> tell ["_"] >> genName n | (tag, _) <- ts]
|
||||||
-- You aren't allowed to have an empty enum.
|
-- You aren't allowed to have an empty enum.
|
||||||
when (ts == []) $
|
when (ts == []) $
|
||||||
tell ["empty_protocol_"] >> genName n
|
tell ["empty_protocol_"] >> genName n
|
||||||
tell ["\n"]
|
tell ["}"]
|
||||||
tell ["} "]
|
|
||||||
genName n
|
genName n
|
||||||
tell [";\n"]
|
tell [";"]
|
||||||
cintroduceSpec ops (A.Specification _ n (A.Proc _ sm fs p))
|
cintroduceSpec ops (A.Specification _ n (A.Proc _ sm fs p))
|
||||||
= do call genSpecMode ops sm
|
= do call genSpecMode ops sm
|
||||||
tell ["void "]
|
tell ["void "]
|
||||||
|
|
|
@ -943,20 +943,6 @@ cppintroduceSpec ops (A.Specification _ n (A.RecordType _ b fs))
|
||||||
when b $ tell [" occam_struct_packed "]
|
when b $ tell [" occam_struct_packed "]
|
||||||
genName n
|
genName n
|
||||||
tell [";"]
|
tell [";"]
|
||||||
--We do variant protocols by introducing a new variant:
|
|
||||||
cppintroduceSpec _ (A.Specification _ n (A.ProtocolCase _ []))
|
|
||||||
= do tell ["typedef class {} "]
|
|
||||||
genName n
|
|
||||||
tell [";"]
|
|
||||||
cppintroduceSpec ops (A.Specification _ n (A.ProtocolCase _ caseList))
|
|
||||||
= do sequence_ [tell ["class "] >> genProtocolTagName n tag >> tell [" {}; "] | (tag , _) <- caseList]
|
|
||||||
cgmap (typedef_genCaseType n) caseList
|
|
||||||
createChainedType "boost::variant" (genProtocolName n) $ map ((genTupleProtocolTagName n) . fst) caseList
|
|
||||||
where
|
|
||||||
typedef_genCaseType :: A.Name -> (A.Name, [A.Type]) -> CGen()
|
|
||||||
typedef_genCaseType n (tag, typeList)
|
|
||||||
= createChainedType "boost::tuple" (genTupleProtocolTagName n tag) ((genProtocolTagName n tag) : (map (call genType ops) typeList))
|
|
||||||
|
|
||||||
--Clause changed to handle array retyping
|
--Clause changed to handle array retyping
|
||||||
cppintroduceSpec ops (A.Specification _ n (A.Retypes m am t v))
|
cppintroduceSpec ops (A.Specification _ n (A.Retypes m am t v))
|
||||||
= do origT <- typeOfVariable v
|
= do origT <- typeOfVariable v
|
||||||
|
|
|
@ -499,11 +499,14 @@ testSpec = TestList
|
||||||
-- I don't think ValAbbrev of channels/channel-ends makes much sense (occam doesn't support it, certainly) so they are not tested here.
|
-- I don't think ValAbbrev of channels/channel-ends makes much sense (occam doesn't support it, certainly) so they are not tested here.
|
||||||
|
|
||||||
--TODO test Is more (involving subscripts, arrays and slices)
|
--TODO test Is more (involving subscripts, arrays and slices)
|
||||||
|
|
||||||
|
--ProtocolCase:
|
||||||
|
,testAllSame 800 ("typedef enum{empty_protocol_foo}foo;","") $ A.ProtocolCase emptyMeta []
|
||||||
|
,testAllSame 801 ("typedef enum{bar_foo}foo;","") $ A.ProtocolCase emptyMeta [(bar,[])]
|
||||||
|
,testAllSame 802 ("typedef enum{bar_foo,wibble_foo}foo;","") $ A.ProtocolCase emptyMeta [(bar,[]),(simpleName "wibble",[])]
|
||||||
|
|
||||||
|
|
||||||
--TODO IsExpr
|
--TODO IsExpr
|
||||||
--TODO Protocol
|
|
||||||
--TODO ProtocolCase
|
|
||||||
--TODO Proc
|
--TODO Proc
|
||||||
--TODO Retypes
|
--TODO Retypes
|
||||||
]
|
]
|
||||||
|
|
Loading…
Reference in New Issue
Block a user