diff --git a/common/TestUtil.hs b/common/TestUtil.hs index 521281c..174111d 100644 --- a/common/TestUtil.hs +++ b/common/TestUtil.hs @@ -354,6 +354,7 @@ data ExprHelper = | Var String | DirVar A.Direction String | Lit A.Expression + | EHTrue buildExprPattern :: ExprHelper -> Pattern buildExprPattern (Dy lhs op rhs) = tag4 A.Dyadic DontCare op (buildExprPattern lhs) (buildExprPattern rhs) @@ -362,6 +363,7 @@ buildExprPattern (Cast ty rhs) = tag4 A.Conversion DontCare A.DefaultConversion buildExprPattern (Var n) = tag2 A.ExprVariable DontCare $ variablePattern n buildExprPattern (DirVar dir n) = tag2 A.ExprVariable DontCare $ (stopCaringPattern m $ tag3 A.DirectedVariable DontCare dir $ variablePattern n) buildExprPattern (Lit e) = (stopCaringPattern m) $ mkPattern e +buildExprPattern EHTrue = tag1 A.True DontCare buildExpr :: ExprHelper -> A.Expression buildExpr (Dy lhs op rhs) = A.Dyadic m op (buildExpr lhs) (buildExpr rhs) @@ -370,6 +372,7 @@ buildExpr (Cast ty rhs) = A.Conversion m A.DefaultConversion ty (buildExpr rhs) buildExpr (Var n) = A.ExprVariable m $ variable n buildExpr (DirVar dir n) = A.ExprVariable m $ (A.DirectedVariable m dir $ variable n) buildExpr (Lit e) = e +buildExpr EHTrue = A.True m -- | A simple definition of a variable simpleDef :: String -> A.SpecType -> A.NameDef diff --git a/frontends/RainTypes.hs b/frontends/RainTypes.hs index cc78b1a..de2a830 100644 --- a/frontends/RainTypes.hs +++ b/frontends/RainTypes.hs @@ -232,3 +232,21 @@ checkAssignmentTypes = everywhereASTM checkAssignment checkAssignment (A.Assign {}) = dieInternal "Rain checker found occam-style assignment" checkAssignment st = return st +-- | Checks the types in if and while conditionals +checkConditionalTypes :: Data t => t -> PassM t +checkConditionalTypes t = (everywhereASTM checkWhile t) >>= (everywhereASTM checkIf) + where + checkWhile :: A.Process -> PassM A.Process + checkWhile w@(A.While m exp _) + = do t <- typeOfExpression exp + if (t == A.Bool) + then return w + else dieP m "Expression in while conditional must be of boolean type" + checkWhile p = return p + + checkIf :: A.Choice -> PassM A.Choice + checkIf c@(A.Choice m exp _) + = do t <- typeOfExpression exp + if (t == A.Bool) + then return c + else dieP m "Expression in if conditional must be of boolean type" diff --git a/frontends/RainTypesTest.hs b/frontends/RainTypesTest.hs index 4c776cc..cc104e1 100644 --- a/frontends/RainTypesTest.hs +++ b/frontends/RainTypesTest.hs @@ -167,7 +167,9 @@ checkExpressionTest = TestList ,passAssignSame 3002 "b" (Var "b") ,passAssignSame 3003 "x" $ Dy (Var "x") A.Plus (Var "x") ,passAssignSame 3004 "b" $ Dy (Var "x8") A.Eq (Var "x8") - ,passAssignSame 3004 "x" $ Mon A.MonadicMinus (Var "x") + ,passAssignSame 3005 "x" $ Mon A.MonadicMinus (Var "x") + ,passAssignSame 3006 "x8" $ int A.Int8 0 + ,passAssignSame 3007 "b" EHTrue ,passAssign 3100 "x" (Cast A.Int64 $ Var "xu8") (Var "xu8") ,failAssign 3101 "xu8" (Var "x") @@ -175,6 +177,18 @@ checkExpressionTest = TestList ,failAssign 3103 "b" (Var "x") ,failAssign 3104 "x8" (Var "xu8") ,failAssign 3105 "xu8" (Var "x8") + ,passAssign 3106 "x" (Cast A.Int64 $ int A.Int8 0) (int A.Int8 0) + + --Conditionals: + ,passWhileIfSame 4000 $ Var "b" + ,passWhileIfSame 4001 $ Mon A.MonadicNot $ Var "b" + ,passWhileIfSame 4002 $ Dy (Var "x") A.Eq (Var "x") + ,passWhileIfSame 4003 $ EHTrue + + ,failWhileIf 4100 $ Var "x" + ,failWhileIf 4101 $ Dy (Var "x") A.Plus (Var "x") + + ] where passAssign :: Int -> String -> ExprHelper -> ExprHelper -> Test @@ -193,6 +207,33 @@ checkExpressionTest = TestList failAssign :: Int -> String -> ExprHelper -> Test failAssign n lhs src = TestCase $ testPassShouldFail ("checkExpressionTest " ++ show n) (checkAssignmentTypes $ A.Assign m [variable lhs] $ A.ExpressionList m [buildExpr src]) state + + passWhileIfSame :: Int -> ExprHelper -> Test + passWhileIfSame n e = passWhileIf n e e + + passWhileIf :: Int -> ExprHelper -> ExprHelper -> Test + passWhileIf n exp src = TestList + [ + TestCase $ testPass ("checkExpressionTest/if " ++ show n) + (tag2 A.If DontCare $ tag2 A.OnlyC DontCare $ tag3 A.Choice DontCare (buildExprPattern exp) (tag1 A.Skip DontCare)) + (checkConditionalTypes $ A.If m $ A.OnlyC m $ A.Choice m (buildExpr src) (A.Skip m)) + state + ,TestCase $ testPass ("checkExpressionTest/while " ++ show n) + (tag3 A.While DontCare (buildExprPattern exp) (tag1 A.Skip DontCare)) + (checkConditionalTypes $ A.While m (buildExpr src) (A.Skip m)) + state + ] + + failWhileIf :: Int -> ExprHelper -> Test + failWhileIf n src = TestList + [ + TestCase $ testPassShouldFail ("checkExpressionTest/if " ++ show n) + (checkConditionalTypes $ A.If m $ A.OnlyC m $ A.Choice m (buildExpr src) (A.Skip m)) + state + ,TestCase $ testPassShouldFail ("checkExpressionTest/while " ++ show n) + (checkConditionalTypes $ A.While m (buildExpr src) (A.Skip m)) + state + ] passSame :: Int -> A.Type -> ExprHelper -> Test passSame n t e = pass n t e e