From 6861b22da6679defa68a3c6b98455d2159a697d0 Mon Sep 17 00:00:00 2001
From: Adam Sampson <ats@offog.org>
Date: Tue, 25 Mar 2008 16:45:25 +0000
Subject: [PATCH] Check timer operations.

---
 common/TestUtils.hs         |  5 +++++
 frontends/OccamTypes.hs     | 28 +++++++++++++++++++++++-----
 frontends/OccamTypesTest.hs | 13 +++++++++++++
 3 files changed, 41 insertions(+), 5 deletions(-)

diff --git a/common/TestUtils.hs b/common/TestUtils.hs
index 220a828..1c5928b 100644
--- a/common/TestUtils.hs
+++ b/common/TestUtils.hs
@@ -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
diff --git a/frontends/OccamTypes.hs b/frontends/OccamTypes.hs
index 3c8228d..d222c09 100644
--- a/frontends/OccamTypes.hs
+++ b/frontends/OccamTypes.hs
@@ -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)
diff --git a/frontends/OccamTypesTest.hs b/frontends/OccamTypesTest.hs
index bb9c9be..e9d3a7a 100644
--- a/frontends/OccamTypesTest.hs
+++ b/frontends/OccamTypesTest.hs
@@ -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