Added a new function that checks that variables are initialised before they are read in a control-flow graph, and added tests for it (that all now pass)

This commit is contained in:
Neil Brown 2007-11-01 11:45:36 +00:00
parent 75ed35f2e3
commit cf0cc81ae4
2 changed files with 95 additions and 0 deletions

View File

@ -24,11 +24,14 @@ module RainUsageCheck where
import Control.Monad.Identity
import Data.Generics
import Data.Graph.Inductive
import Data.List
import qualified Data.Map as Map
import Data.Maybe
import qualified Data.Set as Set
import qualified AST as A
import FlowAlgorithms
import FlowGraph
-- In Rain, Deref can't nest with Dir in either way, so this doesn't need to be a recursive type:
@ -245,3 +248,41 @@ parUsageCheck proc
subscriptedArrays' (A.SubscriptedVariable _ _ v) = Just v
subscriptedArrays' _ = Nothing
-}
-- TODO have some sort of error-message return if the check fails or if the code fails
checkInitVar :: FlowGraph (Maybe Decl, Vars) -> Node -> Bool
checkInitVar graph startNode = and $ map (checkInitVar' varWrittenBefore) (map readNode (labNodes graph))
where
readNode :: (Node, FNode (Maybe Decl, Vars)) -> (Node, Set.Set Var)
readNode (n, Node (_,(_,Vars read _ _ _))) = (n,read)
writeNode :: FNode (Maybe Decl, Vars) -> Set.Set Var
writeNode (Node (_,(_,Vars _ _ written _))) = written
-- Nothing is treated as if were the set of all possible variables (easier than building that set):
nodeFunction :: (Node, EdgeLabel) -> Set.Set Var -> Maybe (Set.Set Var) -> Set.Set Var
nodeFunction (n,_) inputVal Nothing = Set.union inputVal (maybe Set.empty writeNode (lab graph n))
nodeFunction (n, EEndPar _) inputVal (Just prevAgg) = Set.unions [inputVal,prevAgg,maybe Set.empty writeNode (lab graph n)]
nodeFunction (n, _) inputVal (Just prevAgg) = Set.intersection prevAgg $ Set.union inputVal (maybe Set.empty writeNode (lab graph n))
graphFuncs :: GraphFuncs Node EdgeLabel (Set.Set Var)
graphFuncs = GF
{
nodeFunc = nodeFunction
,prevNodes = lpre graph
,nextNodes = lsuc graph
,initVal = Set.empty
,defVal = Set.empty
}
varWrittenBefore :: Map.Map Node (Set.Set Var)
varWrittenBefore = flowAlgorithm graphFuncs (nodes graph) startNode
checkInitVar' :: Map.Map Node (Set.Set Var) -> (Node, Set.Set Var) -> Bool
checkInitVar' writtenMap (n,v)
= case Map.lookup n writtenMap of
Nothing -> False
-- All read vars should be in the previously-written set
Just vs -> v `Set.isSubsetOf` vs

View File

@ -18,11 +18,13 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
module RainUsageCheckTest (tests) where
import Data.Graph.Inductive
import Prelude hiding (fail)
import Test.HUnit
import qualified AST as A
import FlowGraph
import Metadata
import RainUsageCheck
import TestUtil
@ -129,10 +131,62 @@ testParUsageCheck = TestList (map doTest tests)
--TODO add tests for initialising a variable before use.
--TODO especially test things like only initialising the variable in one part of an if
buildTestFlowGraph :: [(Int, [Var], [Var], [Var])] -> [(Int, Int, EdgeLabel)] -> Int -> Int -> String -> FlowGraph (Maybe Decl, Vars)
buildTestFlowGraph ns es start end v
= mkGraph
([(-1,Node (emptyMeta,(Just $ ScopeIn v, emptyVars))),(-2,Node (emptyMeta,(Just $ ScopeOut v,emptyVars)))] ++ (map transNode ns))
([(-1,start,ESeq),(end,-2,ESeq)] ++ es)
where
transNode :: (Int, [Var], [Var], [Var]) -> (Int, FNode (Maybe Decl, Vars))
transNode (n,mr,mw,dw) = (n,Node (emptyMeta, (Nothing,vars mr mw dw [])))
testInitVar :: Test
testInitVar = TestList
[
testInitVarPass 0 [(0,[],[],[])] [] 0 0 "x"
,testInitVarPass 1 [(0,[],[],[Plain "x"])] [] 0 0 "x"
,testInitVarFail 2 [(0,[Plain "x"],[],[])] [] 0 0 "x"
,testInitVarFail 3 [(0,[Plain "x"],[],[Plain "x"])] [] 0 0 "x"
,testInitVarPass 10 [(0,[],[],[Plain "x"]), (1,[Plain "x"],[],[])] [(0,1,ESeq)] 0 1 "x"
,testInitVarFail 11 [(0,[],[],[Plain "x"]), (1,[Plain "x"],[],[])] [(1,0,ESeq)] 1 0 "x"
,testInitVarFail 12 [(0,[],[Plain "x"],[]), (1,[Plain "x"],[],[])] [(0,1,ESeq)] 0 1 "x"
,testInitVarPass 13 [(0,[],[],[Plain "x"]), (1,[Plain "x"],[],[])] [(0,1,EStartPar 0)] 0 1 "x"
,testInitVarPass 14 [(0,[],[],[Plain "x"]), (1,[Plain "x"],[],[])] [(0,1,EEndPar 0)] 0 1 "x"
,testInitVarPass 20 [(0,[],[],[]),(1,[],[],[Plain "x"]), (2,[],[],[Plain "x"]), (3,[Plain "x"],[],[])] [(0,1,ESeq),(0,2,ESeq),(1,3,ESeq),(2,3,ESeq)] 0 3 "x"
,testInitVarFail 21 [(0,[],[],[]),(1,[],[],[]), (2,[],[],[Plain "x"]), (3,[Plain "x"],[],[])] [(0,1,ESeq),(0,2,ESeq),(1,3,ESeq),(2,3,ESeq)] 0 3 "x"
,testInitVarFail 22 [(0,[],[],[]),(1,[],[Plain "x"],[]), (2,[],[],[Plain "x"]), (3,[Plain "x"],[],[])] [(0,1,ESeq),(0,2,ESeq),(1,3,ESeq),(2,3,ESeq)] 0 3 "x"
,testInitVarPass 23 [(0,[],[],[]),(1,[],[],[]), (2,[],[],[Plain "x"]), (3,[Plain "x"],[],[])] [(0,1,ESeq),(0,2,ESeq),(2,3,ESeq)] 0 3 "x"
,testInitVarPass 24 [(0,[],[],[Plain "x"]),(1,[],[],[]), (2,[],[],[]), (3,[Plain "x"],[],[])] [(0,1,ESeq),(0,2,ESeq),(1,3,ESeq),(2,3,ESeq)] 0 3 "x"
,testInitVarFail 25 [(0,[],[],[]),(1,[],[],[]), (2,[],[],[]), (3,[Plain "x"],[],[])] [(0,1,ESeq),(0,2,ESeq),(1,3,ESeq),(2,3,ESeq)] 0 3 "x"
-- This would fail CREW, but that's not what we're testing here:
,testInitVarPass 30 [(0,[],[],[]),(1,[],[],[Plain "x"]), (2,[],[],[Plain "x"]), (3,[Plain "x"],[],[])]
[(0,1,EStartPar 0),(0,2,EStartPar 0),(1,3,EEndPar 0),(2,3,EEndPar 0)] 0 3 "x"
,testInitVarPass 31 [(0,[],[],[]),(1,[],[],[Plain "x"]), (2,[],[],[]), (3,[Plain "x"],[],[])]
[(0,1,EStartPar 0),(0,2,EStartPar 0),(1,3,EEndPar 0),(2,3,EEndPar 0)] 0 3 "x"
,testInitVarPass 32 [(0,[],[],[Plain "x"]),(1,[],[],[]), (2,[],[],[]), (3,[Plain "x"],[],[])]
[(0,1,EStartPar 0),(0,2,EStartPar 0),(1,3,EEndPar 0),(2,3,EEndPar 0)] 0 3 "x"
,testInitVarFail 33 [(0,[],[],[]),(1,[],[],[]), (2,[],[],[]), (3,[Plain "x"],[],[])]
[(0,1,EStartPar 0),(0,2,EStartPar 0),(1,3,EEndPar 0),(2,3,EEndPar 0)] 0 3 "x"
-- TODO add tests with loops (and work out how to represent par loops)
]
where
testInitVarPass :: Int -> [(Int, [Var], [Var], [Var])] -> [(Int, Int, EdgeLabel)] -> Int -> Int -> String -> Test
testInitVarPass testNum ns es start end v = TestCase $ assertBool ("testInitVar " ++ show testNum) $ checkInitVar (buildTestFlowGraph ns es start end v) (-1)
testInitVarFail :: Int -> [(Int, [Var], [Var], [Var])] -> [(Int, Int, EdgeLabel)] -> Int -> Int -> String -> Test
testInitVarFail testNum ns es start end v = TestCase $ assertBool ("testInitVar " ++ show testNum) $ not $ checkInitVar (buildTestFlowGraph ns es start end v) (-1)
tests :: Test
tests = TestList
[
testGetVarProc
,testInitVar
-- ,testParUsageCheck
]