Commit a68ce6c3 authored by Jan Rasmus Tikovsky 's avatar Jan Rasmus Tikovsky
Browse files

Merge branch 'WarningsFeature'

parents 59d75a24 fc41b709
module Base.Messages
( -- * Output of user information
status, warn, putErrLn, putErrsLn
status, putErrLn, putErrsLn
-- * program abortion
, abortWith, abortWithMessage, abortWithMessages
, abortWith, abortWithMessage, abortWithMessages, warnOrAbort
, internalError, errorMessage, errorMessages
-- * creating messages
, Message, message, posMessage
......@@ -15,23 +15,14 @@ import Data.List (sort)
import System.IO (hFlush, hPutStrLn, stderr, stdout)
import System.Exit (exitFailure)
import Curry.Base.Message ( Message, message, posMessage, ppMessage
, ppMessages, ppWarning, ppError)
import Curry.Base.Monad (CYIO, failMessages)
import Curry.Base.Pretty (text)
import Curry.Base.Message ( Message, message, posMessage, ppWarning
, ppMessages, ppError)
import Curry.Base.Pretty (Doc, text)
import CompilerOpts (Options (..), WarnOpts (..), Verbosity (..))
status :: MonadIO m => Options -> String -> m ()
status opts msg = unless (optVerbosity opts < VerbStatus) (putMsg msg)
-- TODO: bad code: Extend Curry monads (CYT / CYIO) to also track warnings
-- (see ticket 1246)
warn :: WarnOpts -> [Message] -> CYIO ()
warn opts msgs = when (wnWarn opts && not (null msgs)) $ do
if wnWarnAsError opts
then failMessages (msgs ++ [message $ text "Failed due to -Werror"])
else liftIO $ putErrLn (show $ ppMessages ppWarning $ sort msgs)
-- |Print a message on 'stdout'
putMsg :: MonadIO m => String -> m ()
putMsg msg = liftIO (putStrLn msg >> hFlush stdout)
......@@ -55,9 +46,20 @@ abortWithMessage msg = abortWithMessages [msg]
-- |Print a list of error messages on 'stderr' and abort the program
abortWithMessages :: [Message] -> IO a
abortWithMessages msgs = do
unless (null msgs) $ putErrLn (show $ ppMessages ppMessage $ sort msgs)
exitFailure
abortWithMessages msgs = printMessages ppError msgs >> exitFailure
-- |Print a list of warning messages on 'stderr' and abort the program
-- |if the -Werror option is set
warnOrAbort :: WarnOpts -> [Message] -> IO ()
warnOrAbort opts msgs = when (wnWarn opts && not (null msgs)) $ do
if wnWarnAsError opts
then abortWithMessages (msgs ++ [message $ text "Failed due to -Werror"])
else printMessages ppWarning msgs
-- |Print a list of messages on 'stderr'
printMessages :: (Message -> Doc) -> [Message] -> IO ()
printMessages msgType msgs
= unless (null msgs) $ putErrLn (show $ ppMessages msgType $ sort msgs)
-- |Raise an internal error
internalError :: String -> a
......
......@@ -107,7 +107,7 @@ compileInterface ctxt (p, m) fn = do
mbSrc <- liftIO $ readModule fn
case mbSrc of
Nothing -> report [errInterfaceNotFound p m]
Just src -> case runCYM (parseInterface fn src) of
Just src -> case runCYMIgnWarn (parseInterface fn src) of
Left err -> report err
Right intf@(Interface n is _) ->
if m /= n
......
......@@ -85,7 +85,7 @@ compileModule opts fn = do
loadAndCheckModule :: Options -> FilePath -> CYIO (CompEnv CS.Module)
loadAndCheckModule opts fn = do
(env, mdl) <- loadModule opts fn >>= checkModule opts
warn (optWarnOpts opts) $ warnCheck opts env mdl
warnMessages $ warnCheck opts env mdl
return (env, mdl)
-- ---------------------------------------------------------------------------
......@@ -286,7 +286,7 @@ matchInterface :: FilePath -> CS.Interface -> IO Bool
matchInterface ifn i = do
hdl <- openFile ifn ReadMode
src <- hGetContents hdl
case runCYM (CS.parseInterface ifn src) of
case runCYMIgnWarn (CS.parseInterface ifn src) of
Left _ -> hClose hdl >> return False
Right i' -> return (i `intfEquiv` fixInterface i')
......
......@@ -39,8 +39,11 @@ cymake (prog, opts, files, errs)
runCYIO (mapM_ (source2html opts) files) >>= okOrAbort
| otherwise =
runCYIO (mapM_ (buildCurry opts) files) >>= okOrAbort
where mode = optMode opts
okOrAbort = either abortWithMessages return
where
mode = optMode opts
warnOpts = optWarnOpts opts
okOrAbort = either abortWithMessages continueWithMessages
continueWithMessages = warnOrAbort warnOpts . snd
-- |Print the usage information of the command line tool
printUsage :: String -> IO ()
......
......@@ -42,23 +42,25 @@ tests = return [passingTests, warningTests, failingTests]
-- Execute a test by calling cymake
runTest :: CO.Options -> String -> [String] -> IO Progress
runTest opts test [] = runCYIO (buildCurry opts test) >>= passOrFail
runTest opts test [] = runCYIO (buildCurry opts' test) >>= passOrFail
where
passOrFail = (Finished <$>) . either fail pass
opts' = opts { CO.optForce = True }
passOrFail = (Finished <$>) . either fail pass
fail msgs
| null msgs = return Pass
| otherwise = return $ Fail $ "An unexpected failure occurred"
pass _ = return Pass
| otherwise = let errorStr = showMessages msgs
in return $ Fail $ "An unexpected failure occurred: " ++ errorStr
pass _ = return Pass
runTest opts test errorMsgs = runCYIO (buildCurry opts' test) >>= catchE
where
opts' = opts { CO.optWarnOpts =
CO.defaultWarnOpts { CO.wnWarnAsError = True } }
catchE = (Finished <$>) . either pass fail
pass msgs = let errorStr = showMessages msgs
in if all (`isInfixOf` errorStr) errorMsgs
then return Pass
else return $ Fail $ "Expected warning/failure did not occur: " ++ errorStr
fail _ = return $ Fail "Expected warning/failure did not occur"
opts' = opts { CO.optForce = True }
catchE = (Finished <$>) . either pass fail
pass msgs = let errorStr = showMessages msgs
in if all (`isInfixOf` errorStr) errorMsgs
then return Pass
else return $ Fail $ "Expected warning/failure did not occur: "
++ errorStr
fail = pass . snd
showMessages :: [Message] -> String
showMessages = show . ppMessages ppError . sort
......@@ -275,4 +277,6 @@ warnInfos = map (uncurry mkFailTest)
)
, ("ShadowingSymbols",
[ "Unused declaration of variable `x'", "Shadowing symbol `x'"])
, ("TabCharacter",
[ "Tab character"])
]
f :: Int
f = let x = 42 in x
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment