From bd26f758b4b9b9ed4be07e130c95731e6f7bf1e6 Mon Sep 17 00:00:00 2001
From: Neil Brown <neil@twistedsquare.com>
Date: Thu, 20 Mar 2008 14:44:19 +0000
Subject: [PATCH] Added tests for annotating the types of list literals and
 ranges in Rain

---
 common/TestUtils.hs        |  4 ++++
 frontends/RainTypes.hs     |  4 ++++
 frontends/RainTypesTest.hs | 36 ++++++++++++++++++++++++++++++++++++
 3 files changed, 44 insertions(+)

diff --git a/common/TestUtils.hs b/common/TestUtils.hs
index 3d888f7..0280e60 100644
--- a/common/TestUtils.hs
+++ b/common/TestUtils.hs
@@ -167,6 +167,10 @@ exprDirVariable dir e = A.ExprVariable emptyMeta $ A.DirectedVariable emptyMeta
 exprVariablePattern :: String -> Pattern
 exprVariablePattern e = tag2 A.ExprVariable DontCare $ variablePattern e
 
+-- | Creates a char (Byte) literal with the given char
+charLiteral :: Char -> A.Expression
+charLiteral c = A.Literal emptyMeta A.Byte $ A.ByteLiteral emptyMeta [c]
+
 -- | Creates an integer literal 'A.Expression' with the given integer.
 integerLiteral :: A.Type -> Integer -> A.Expression
 integerLiteral t n = A.Literal emptyMeta t $ A.IntLiteral emptyMeta (show n)
diff --git a/frontends/RainTypes.hs b/frontends/RainTypes.hs
index c799864..33b098f 100644
--- a/frontends/RainTypes.hs
+++ b/frontends/RainTypes.hs
@@ -87,6 +87,10 @@ annnotateIntLiteralTypes = applyDepthM doExpression
         n = read s        
     doExpression e = return e
 
+-- | Annotates all list literals and list ranges with their type
+annotateListLiteralTypes :: Data t => t -> PassM t
+annotateListLiteralTypes = return
+    
 -- | A pass that finds all the 'A.ProcCall' and 'A.FunctionCall' in the AST, and checks that the actual parameters are valid inputs, given the 'A.Formal' parameters in the process's type
 matchParamPass :: Data t => t -> PassM t
 matchParamPass = everywhereM ((mkM matchParamPassProc) `extM` matchParamPassFunc)
diff --git a/frontends/RainTypesTest.hs b/frontends/RainTypesTest.hs
index 74965e9..887f03d 100644
--- a/frontends/RainTypesTest.hs
+++ b/frontends/RainTypesTest.hs
@@ -100,6 +100,41 @@ annotateIntTest = TestList
   failSigned :: Integer -> Test
   failSigned n = TestCase $ testPassShouldFail ("annotateIntTest: " ++ show n) (annnotateIntLiteralTypes $ int64Literal n) (return ())
 
+
+annotateListLiteralTest :: Test
+annotateListLiteralTest = TestList
+  [
+   testList 0 A.Int [intLiteral 0, intLiteral 1]
+  ,testList 1 A.Any []
+  ,testList 2 A.Int [charLiteral 'c', intLiteral 6]
+  ,testList 3 A.Int64 [intLiteral 3, intLiteral 5, int64Literal 2,
+    intLiteral 2]
+   -- TODO test with variables (and implicit upcasting)
+  
+   -- TODO test ranges with variables too
+  ,testRange 1000 A.Int (intLiteral 0) (intLiteral 1)
+  ,testRange 1001 A.Int64 (intLiteral 0) (int64Literal 1)
+  ,testRange 1002 A.Int64 (int64Literal 0) (intLiteral 1)
+  ,testRange 1003 A.Int (charLiteral 'a') (intLiteral 1)
+  ,testRange 1004 A.Int (intLiteral 0) (charLiteral 'b')
+  ,testRange 1005 A.Int64 (charLiteral 'e') (int64Literal 1)
+  ,testRange 1006 A.Int64 (int64Literal 0) (charLiteral 'f')
+  ,testRange 1007 A.Byte (charLiteral 'd') (charLiteral 'f')
+  ]
+  where
+    testList :: Int -> A.Type -> [A.Expression] -> Test
+    testList n t es = TestCase $ testPass ("annotateListLiteralTest: " ++
+      show n) (mLiteral (A.List t) $ mListLiteral es)
+      (annotateListLiteralTypes $ A.Literal emptyMeta A.Any $ A.ListLiteral emptyMeta es)
+      (return ())
+
+    testRange :: Int -> A.Type -> A.Expression -> A.Expression -> Test
+    testRange n t b e = TestCase $ testPass ("annotateListLiteralTest: "
+      ++ show n) (mExprConstr $ mRangeConstr t b e)
+      (annotateListLiteralTypes $ A.ExprConstr emptyMeta $
+        A.RangeConstr emptyMeta A.Any b e)
+      (return ())
+
 -- | An amazing amount of tests for testing the Rain type-checker for all the different forms of statement,
 -- such as assignment, expressions, communications, etc etc.
 --TODO add typechecks for expressions involving channels
@@ -416,5 +451,6 @@ tests = TestLabel "RainTypesTest" $ TestList
  [
   constantFoldTest
   ,annotateIntTest
+  ,annotateListLiteralTest
   ,checkExpressionTest
  ]