Made running the properties configurable by a --sanity-check command-line option
This commit is contained in:
parent
feabd450f0
commit
6d9534f9b9
9
Main.hs
9
Main.hs
|
@ -61,6 +61,7 @@ options =
|
||||||
, Option ['v'] ["verbose"] (NoArg $ optVerbose) "be more verbose (use multiple times for more detail)"
|
, Option ['v'] ["verbose"] (NoArg $ optVerbose) "be more verbose (use multiple times for more detail)"
|
||||||
, Option ['o'] ["output"] (ReqArg optOutput "FILE") "output file (default \"-\")"
|
, Option ['o'] ["output"] (ReqArg optOutput "FILE") "output file (default \"-\")"
|
||||||
, Option [] ["usage-checking"] (ReqArg optUsageChecking "SETTING") "usage checking (EXPERIMENTAL) (options: on, off)"
|
, Option [] ["usage-checking"] (ReqArg optUsageChecking "SETTING") "usage checking (EXPERIMENTAL) (options: on, off)"
|
||||||
|
, Option [] ["sanity-check"] (ReqArg optSanityCheck "SETTING") "internal sanity check (options: on, off)"
|
||||||
]
|
]
|
||||||
|
|
||||||
optMode :: String -> OptFunc
|
optMode :: String -> OptFunc
|
||||||
|
@ -105,6 +106,14 @@ optUsageChecking s ps
|
||||||
_ -> dieIO (Nothing, "Unknown usage checking mode: " ++ s)
|
_ -> dieIO (Nothing, "Unknown usage checking mode: " ++ s)
|
||||||
return $ ps { csUsageChecking = usageCheck }
|
return $ ps { csUsageChecking = usageCheck }
|
||||||
|
|
||||||
|
optSanityCheck :: String -> OptFunc
|
||||||
|
optSanityCheck s ps
|
||||||
|
= do sanityCheck <- case s of
|
||||||
|
"on" -> return True
|
||||||
|
"off" -> return False
|
||||||
|
_ -> dieIO (Nothing, "Unknown sanity checking mode: " ++ s)
|
||||||
|
return $ ps { csSanityCheck = sanityCheck }
|
||||||
|
|
||||||
getOpts :: [String] -> IO ([OptFunc], [String])
|
getOpts :: [String] -> IO ([OptFunc], [String])
|
||||||
getOpts argv =
|
getOpts argv =
|
||||||
case getOpt RequireOrder options argv of
|
case getOpt RequireOrder options argv of
|
||||||
|
|
|
@ -57,6 +57,7 @@ data CompState = CompState {
|
||||||
csMode :: CompMode,
|
csMode :: CompMode,
|
||||||
csBackend :: CompBackend,
|
csBackend :: CompBackend,
|
||||||
csFrontend :: CompFrontend,
|
csFrontend :: CompFrontend,
|
||||||
|
csSanityCheck :: Bool,
|
||||||
csUsageChecking :: Bool,
|
csUsageChecking :: Bool,
|
||||||
csVerboseLevel :: Int,
|
csVerboseLevel :: Int,
|
||||||
csOutputFile :: String,
|
csOutputFile :: String,
|
||||||
|
@ -89,6 +90,7 @@ emptyState = CompState {
|
||||||
csMode = ModeFull,
|
csMode = ModeFull,
|
||||||
csBackend = BackendC,
|
csBackend = BackendC,
|
||||||
csFrontend = FrontendOccam,
|
csFrontend = FrontendOccam,
|
||||||
|
csSanityCheck = False,
|
||||||
csUsageChecking = False, -- For now! TODO turn this on by default
|
csUsageChecking = False, -- For now! TODO turn this on by default
|
||||||
csVerboseLevel = 0,
|
csVerboseLevel = 0,
|
||||||
csOutputFile = "-",
|
csOutputFile = "-",
|
||||||
|
|
|
@ -69,8 +69,9 @@ getPassList optsPS = filterPasses optsPS $ concat
|
||||||
|
|
||||||
calculatePassList :: (Die m, CSMR m) => m [Pass]
|
calculatePassList :: (Die m, CSMR m) => m [Pass]
|
||||||
calculatePassList
|
calculatePassList
|
||||||
= do rawList <- getCompState >>* getPassList
|
= do st <- getCompState
|
||||||
case buildGraph rawList of
|
let rawList = getPassList st
|
||||||
|
case buildGraph (csSanityCheck st) rawList of
|
||||||
Left err -> dieReport (Nothing, "Error working out pass list: " ++ err)
|
Left err -> dieReport (Nothing, "Error working out pass list: " ++ err)
|
||||||
Right g -> return $ graphToList (g :: Gr Pass ())
|
Right g -> return $ graphToList (g :: Gr Pass ())
|
||||||
|
|
||||||
|
@ -82,8 +83,9 @@ calculatePassList
|
||||||
graphToList :: Graph gr => gr Pass () -> [Pass]
|
graphToList :: Graph gr => gr Pass () -> [Pass]
|
||||||
graphToList = topsort'
|
graphToList = topsort'
|
||||||
|
|
||||||
buildGraph :: forall gr. Graph gr => [Pass] -> Either String (gr Pass ())
|
buildGraph :: forall gr. Graph gr => Bool -> [Pass] -> Either String (gr Pass ())
|
||||||
buildGraph passes = do checked <- checkedRelations
|
buildGraph runProps passes
|
||||||
|
= do checked <- checkedRelations
|
||||||
checkPassUnique
|
checkPassUnique
|
||||||
checkGraph
|
checkGraph
|
||||||
nodes <- labelledNodes
|
nodes <- labelledNodes
|
||||||
|
@ -98,7 +100,7 @@ buildGraph passes = do checked <- checkedRelations
|
||||||
|
|
||||||
propToPass :: Property -> Pass
|
propToPass :: Property -> Pass
|
||||||
propToPass prop = Pass {
|
propToPass prop = Pass {
|
||||||
passCode = runPassR (\t -> propCheck prop t >> return t)
|
passCode = if runProps then runPassR (\t -> propCheck prop t >> return t) else return
|
||||||
,passName = prefixPropName (propName prop)
|
,passName = prefixPropName (propName prop)
|
||||||
,passPre = Set.empty
|
,passPre = Set.empty
|
||||||
,passPost = Set.empty
|
,passPost = Set.empty
|
||||||
|
|
Loading…
Reference in New Issue
Block a user