Check timer operations.

This commit is contained in:
Adam Sampson 2008-03-25 16:45:25 +00:00
parent d7e829b4c6
commit 6861b22da6
3 changed files with 41 additions and 5 deletions

View File

@ -338,6 +338,11 @@ defineChannel :: String -> A.Type -> State CompState ()
defineChannel s t
= defineThing s A.ChannelName (A.Declaration emptyMeta t) A.Original
-- | Define a timer.
defineTimer :: String -> A.Type -> State CompState ()
defineTimer s t
= defineThing s A.TimerName (A.Declaration emptyMeta t) A.Original
-- | Define a user data type.
defineUserDataType :: String -> A.Type -> State CompState ()
defineUserDataType s t

View File

@ -354,6 +354,18 @@ checkChannel wantDir c
where
m = findMeta c
-- | Check that a variable is a timer.
-- Return the type of the timer's value.
checkTimer :: A.Variable -> PassM A.Type
checkTimer tim
= do t <- typeOfVariable tim >>= underlyingType m
case t of
A.Timer A.OccamTimer -> return A.Int
A.Timer A.RainTimer -> return A.Time
_ -> diePC m $ formatCode "Expected timer; found %" t
where
m = findMeta tim
-- | Return the list of types carried by a protocol.
-- For a variant protocol, the second argument should be 'Just' the tag.
-- For a non-variant protocol, the second argument should be 'Nothing'.
@ -523,8 +535,6 @@ checkProcesses = checkDepthM doProcess
doProcess (A.Input _ v im) = doInput v im
doProcess (A.Output m v ois) = doOutput m v ois
doProcess (A.OutputCase m v tag ois) = doOutputCase m v tag ois
-- GetTime
-- Wait
-- ClearMobile
-- Skip
-- Stop
@ -553,9 +563,17 @@ checkProcesses = checkDepthM doProcess
doVariant :: A.Type -> A.Variant -> PassM ()
doVariant t (A.Variant m tag iis _)
= checkProtocol m t (Just tag) iis doInputItem
-- InputTimerRead
-- InputTimerAfter
doInput _ _ = ok
doInput c (A.InputTimerRead m ii)
= do t <- checkTimer c
doInputItem t ii
doInput c (A.InputTimerAfter m e)
= do t <- checkTimer c
et <- typeOfExpression e
checkType (findMeta e) t et
doInput c (A.InputTimerFor m e)
= do t <- checkTimer c
et <- typeOfExpression e
checkType (findMeta e) t et
doInputItem :: A.Type -> A.InputItem -> PassM ()
doInputItem (A.Counted wantCT wantAT) (A.InCounted m cv av)

View File

@ -66,6 +66,7 @@ startState
, (simpleName "three", [])
]
defineChannel "chanCaseProto" caseProtoT
defineTimer "tim" $ A.Timer A.OccamTimer
where
intsT = A.Array [A.UnknownDimension] A.Int
arrayLit = A.ArrayLiteral m []
@ -216,6 +217,7 @@ testOccamTypes = TestList
, 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]
@ -253,6 +255,7 @@ testOccamTypes = TestList
, testOK 1110 $ outputSimple intC [oute intE]
, testFail 1111 $ outputSimple intC [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]
@ -268,6 +271,15 @@ testOccamTypes = TestList
, testFail 1136 $ outputCase caseC "two" [oute intE]
, testFail 1137 $ outputCase caseC "herring" [oute intE]
-- Timer operations
, testOK 1180 $ A.Input m tim $ A.InputTimerRead m $ inv intV
, testOK 1181 $ A.Input m tim $ A.InputTimerAfter m intE
, testOK 1182 $ A.Input m tim $ A.InputTimerFor m intE
, testFail 1183 $ A.Input m tim $ A.InputTimerRead m $ inv realV
, testFail 1184 $ A.Input m caseC $ A.InputTimerRead m $ inv intV
, testFail 1185 $ A.Input m tim $ A.InputTimerAfter m realE
, testFail 1186 $ A.Input m tim $ A.InputTimerFor m realE
-- Replicators
, testOK 1200 $ testRep $ A.For m i intE intE
, testFail 1201 $ testRep $ A.For m i realE intE
@ -374,6 +386,7 @@ testOccamTypes = TestList
testChoice c = A.If m $ A.Only m c
inv = A.InVariable m
oute = A.OutExpression m
tim = variable "tim"
--}}}
tests :: Test