Added tests for ProtocolCase in introduceSpec, and made the C++ version behave the same as the C version

This commit is contained in:
Neil Brown 2007-10-06 16:35:02 +00:00
parent 03a4b8e41b
commit 97ee0c4a4e
3 changed files with 8 additions and 20 deletions

View File

@ -1336,15 +1336,14 @@ cintroduceSpec ops (A.Specification _ n (A.RecordType _ b fs))
tell [";"]
cintroduceSpec _ (A.Specification _ n (A.Protocol _ _)) = return ()
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]
-- You aren't allowed to have an empty enum.
when (ts == []) $
tell ["empty_protocol_"] >> genName n
tell ["\n"]
tell ["} "]
tell ["}"]
genName n
tell [";\n"]
tell [";"]
cintroduceSpec ops (A.Specification _ n (A.Proc _ sm fs p))
= do call genSpecMode ops sm
tell ["void "]

View File

@ -943,20 +943,6 @@ cppintroduceSpec ops (A.Specification _ n (A.RecordType _ b fs))
when b $ tell [" occam_struct_packed "]
genName n
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
cppintroduceSpec ops (A.Specification _ n (A.Retypes m am t v))
= do origT <- typeOfVariable v

View File

@ -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.
--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 Protocol
--TODO ProtocolCase
--TODO Proc
--TODO Retypes
]