Merge branch 'WarningsFeature'

src/Base/Messages.hs

 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

src/Interfaces.hs

@@ -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

src/Modules.hs

@@ -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')
 

src/cymake.hs

@@ -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 ()

test/TestFrontend.hs

@@ -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"])
   ]

test/warning/TabCharacter.curry

+f :: Int
+f = let x = 42 in 	x