diff --git a/checks/Check.hs b/checks/Check.hs
index aae5d08..a429821 100644
--- a/checks/Check.hs
+++ b/checks/Check.hs
@@ -20,7 +20,7 @@ with this program. If not, see .
-- the control-flow graph stuff, hence the use of functions that match the dictionary
-- of functions in FlowGraph. This is also why we don't drill down into processes;
-- the control-flow graph means that we only need to concentrate on each node that isn't nested.
-module Check (checkInitVar, usageCheckPass, checkUnusedVar) where
+module Check (checkInitVar, checkInitVarPass, usageCheckPass, checkUnusedVar) where
import Control.Monad.Identity
import Control.Monad.Trans
@@ -183,6 +183,16 @@ showCodeExSet (NormalSet s)
= do ss <- mapM showCode (Set.toList s)
return $ "{" ++ concat (intersperse ", " ss) ++ "}"
+checkInitVarPass :: Pass
+checkInitVarPass = pass "checkInitVar" [] []
+ (passOnlyOnAST "checkInitVar" $
+ \t -> do g' <- buildFlowGraph labelUsageFunctions t
+ (g, roots) <- case g' of
+ Left err -> dieP (findMeta t) err
+ Right (g,rs,_) -> return (g,rs)
+ mapM_ (checkInitVar (findMeta t) g) roots
+ return t)
+
-- | Checks that no variable is used uninitialised. That is, it checks that every variable is written to before it is read.
checkInitVar :: forall m. (Monad m, Die m, Warn m, CSMR m) => Meta -> FlowGraph m UsageLabel -> Node -> m ()
checkInitVar m graph startNode
@@ -274,7 +284,8 @@ checkProcCallArgsUsage = mapM_ checkArgs . listify isProcCall
checkPlainVarUsage (m, mockedupParItems)
checkArrayUsage (m, fmap ((,) []) mockedupParItems)
-
+-- TODO in future change this back to using listify. It just so happened to make
+-- a good test for my new check stuff.
checkUnusedVar :: CheckOptM ()
checkUnusedVar = forAnyASTStruct doSpec
where
diff --git a/checks/UsageCheckTest.hs b/checks/UsageCheckTest.hs
index 9b0d568..a10e543 100644
--- a/checks/UsageCheckTest.hs
+++ b/checks/UsageCheckTest.hs
@@ -32,6 +32,7 @@ import CompState
import Errors
import FlowGraph
import Metadata
+import OccamEDSL
import TestFramework
import TestUtils hiding (Var)
import UsageCheckAlgorithms
@@ -146,8 +147,46 @@ buildTestFlowGraph ns es start end v
testInitVar :: Test
testInitVar = TestList
[
+ test "No variables" $ wrap $ oSEQ []
+ ,test "One unused variable" $ wrap $ oSEQ [decl (return A.Int) oX []]
+ ,test "One written-to variable" $ wrap $
+ oSEQ [
+ decl (return A.Int) oX [
+ oX *:= return (3::Int)
+ ]]
+ ,test "One written-to then self-assigned variable" $ wrap $
+ oSEQ [
+ decl (return A.Int) oX [
+ oX *:= return (3::Int)
+ ,oX *:= oX
+ ]]
+ ,testWarn "One uninit self-assign" $ wrap $
+ oSEQ [
+ decl (return A.Int) oX [
+ oX *:= oX
+ ]]
+ ,testWarn "One written-to variable, one uninit variable" $ wrap $
+ oSEQ [
+ decl (return A.Int) oX [
+ decl (return A.Int) oY [
+ oX *:= oY
+ ]]]
+ ,test "Two parallel written-to variables, then another init" $ wrap $
+ oSEQ [
+ decl (return A.Int) oX [
+ decl (return A.Int) oY [
+ oPAR [
+ oX *:= return (3::Int)
+ ,oY *:= return (4::Int)
+ ]
+ ,decl (return A.Int) oZ [
+ oZ *:= oX *+ oY
+ ,oX *:= oZ
+ ]
+ ]]]
+
-- Single node, x not touched
- testInitVarPass 0 [(0,[],[])] [] 0 0 "x"
+ ,testInitVarPass 0 [(0,[],[])] [] 0 0 "x"
-- Single node, x written to
,testInitVarPass 1 [(0,[],[variable "x"])] [] 0 0 "x"
-- Single node, x read from (FAIL)
@@ -242,6 +281,13 @@ testInitVar = TestList
variable = Var . A.Variable emptyMeta . simpleName
+ wrap x = oPROC "foo" [] x oempty
+
+ test, testWarn :: String -> Occ A.AST -> Test
+ test name x = testOccamPassWarn ("checkInitVar " ++ name) null x checkInitVarPass
+ testWarn name x = testOccamPassWarn ("checkInitVar " ++ name) (not . null) x checkInitVarPass
+
+
{-
testReachDef :: Test
testReachDef = TestList
diff --git a/common/OccamEDSL.hs b/common/OccamEDSL.hs
index 6d96f30..5f716c2 100644
--- a/common/OccamEDSL.hs
+++ b/common/OccamEDSL.hs
@@ -19,10 +19,10 @@ with this program. If not, see .
-- | The necessary components for using an occam EDSL (for building test-cases).
module OccamEDSL (ExpInp, ExpInpT, oSEQ, oPAR, oPROC, oSKIP, oINT,
oCASE, oCASEinput, oALT, guard,
- Occ, oA, oB, oC, oX, oY, oZ, p0, p1, p2, (*?), (*!), (*:=), decl, decl', decl'',
+ Occ, oA, oB, oC, oX, oY, oZ, p0, p1, p2, (*?), (*!), (*:=), (*+), decl, decl', decl'',
oempty, testOccamPass,
oprocess,
- testOccamPassTransform, ExpInpC(shouldComeFrom),
+ testOccamPassWarn, testOccamPassTransform, ExpInpC(shouldComeFrom),
caseOption, inputCaseOption,
becomes) where
@@ -33,6 +33,7 @@ import Test.HUnit hiding (State)
import qualified AST as A
import CompState
+import Errors
import Metadata
import Pass
import Pattern
@@ -257,6 +258,14 @@ oZ = return $ variable "Z"
return $ A.Only emptyMeta $ A.Assign emptyMeta [dest] (A.ExpressionList emptyMeta
[src])
+infix 8 *:=
+
+(*+) :: (CanBeExpression e, CanBeExpression e') => e -> e' -> ExpInp (A.Expression)
+(*+) x y = do x' <- expr x
+ y' <- expr y
+ return (A.Dyadic emptyMeta A.Add x' y')
+
+
decl :: Data a => ExpInp A.Type -> ExpInp A.Variable ->
[O (A.Structured a)] -> O (A.Structured a)
decl bty bvar scope = do
@@ -330,6 +339,21 @@ testOccamPass str code pass
in TestCase $ testPassWithStateCheck str exp pass inp (put inpS) (assertEqual
str (csNames expS) . csNames)
+-- | Give back True if the result is as expected for the warnings
+testOccamPassWarn :: Data a => String -> ([WarningReport] -> Bool) -> O a -> Pass -> Test
+testOccamPassWarn str check code pass
+ = let ExpInpT expm inpm = code
+ (exp, expS) = runState expm emptyState
+ (inp, inpS) = runState inpm emptyState
+ pass' = pass {passCode = \x -> do y <- passCode pass x
+ b <- lift (lift get) >>* check
+ when (not b) $
+ dieP emptyMeta $ str ++ " warnings not as expected"
+ return y}
+ in TestCase $ testPassWithStateCheck str exp pass' inp (put inpS) (assertEqual
+ str (csNames expS) . csNames)
+
+
-- | Like testOccamPass, but applies a transformation to the patterns (such as
-- using stopCaringPattern) before pattern-matching
testOccamPassTransform :: Data a => String -> (Pattern -> Pattern) -> O a -> Pass -> Test