leksah-server-0.12.0.3: tests/TestTool.hs
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
--
-- Module : Main
-- Copyright : 2007-2011 Juergen Nicklisch-Franken, Hamish Mackenzie
-- License : GPL
--
-- Maintainer : maintainer@leksah.org
-- Stability : provisional
-- Portability :
--
-- | Windows systems do not often have a real echo executable (so --with-ghc=echo fails)
--
-----------------------------------------------------------------------------
module Main (
main
) where
import System.Environment (getArgs)
import System.Exit (exitWith, exitSuccess, exitFailure, ExitCode(..))
import IDE.Utils.Tool
(toolProcess, executeGhciCommand, ToolOutput(..), runTool',
newGhci')
#ifdef MIN_VERSION_process_leksah
import IDE.System.Process (interruptProcessGroup, getProcessExitCode)
#else
import System.Process (interruptProcessGroupOf, getProcessExitCode)
#endif
import Test.HUnit
((@=?), (@?=), putTextToHandle, Counts(..), runTestTT, assertBool,
runTestText, (~:), Testable(..), Test(..))
import System.IO (hPutStr, stdout, hPutStrLn, stderr)
import qualified Data.Enumerator.List as EL (consume)
import Control.Concurrent
(threadDelay, forkIO, takeMVar, putMVar, newEmptyMVar)
import Control.Monad.IO.Class (liftIO)
import Control.Monad (forM_)
import System.Log.Logger
(setLevel, rootLoggerName, updateGlobalLogger)
import System.Log (Priority(..))
runSelf' args = runTool' "dist/build/test-tool/test-tool" args Nothing
-- stderr and stdout may not be in sync
check output expected = do
checkFiltered notOut
checkFiltered notErr
where
checkFiltered f = filter f output @?= filter f expected
notErr (ToolError _) = False
notErr _ = True
notOut (ToolOutput _) = False
notOut _ = True
runTests testMVar = loop
where
loop = do
mbTest <- takeMVar testMVar
case mbTest of
Just test -> do
test
loop
Nothing -> return ()
sendTest testMVar test = do
liftIO $ putMVar testMVar $ Just test
doneTesting testMVar = do
liftIO $ putMVar testMVar $ Nothing
tests = test [
"Exit Success" ~: do
(output, _) <- runSelf' ["ExitSuccess"]
output `check` [ToolExit ExitSuccess],
"Exit Failure" ~: do
(output, _) <- runSelf' ["Exit42"]
output `check` [ToolExit (ExitFailure 42)],
"Single Blank Out Line" ~: do
(output, _) <- runSelf' ["BlankLine", "StdOut"]
output `check` [ToolOutput "", ToolExit ExitSuccess],
"Single Blank Err Line" ~: do
(output, _) <- runSelf' ["BlankLine", "StdErr"]
output `check` [ToolError "", ToolExit ExitSuccess],
"Hello Out" ~: do
(output, _) <- runSelf' ["Hello", "StdOut"]
output `check` [ToolOutput "Hello World", ToolExit ExitSuccess],
"Hello Err" ~: do
(output, _) <- runSelf' ["Hello", "StdErr"]
output `check` [ToolError "Hello World", ToolExit ExitSuccess],
"Both" ~: do
(output, _) <- runSelf' ["ErrAndOut"]
output `check` [ToolError "Error", ToolOutput "Output", ToolExit ExitSuccess],
"Unterminated Out" ~: do
(output, _) <- runSelf' ["Unterminated", "StdOut"]
output `check` [ToolOutput "Unterminated", ToolExit ExitSuccess],
"Unterminated Err" ~: do
(output, _) <- runSelf' ["Unterminated", "StdErr"]
output `check` [ToolError "Unterminated", ToolExit ExitSuccess],
"GHCi Failed Sart" ~: do
t <- newEmptyMVar
tool <- newGhci' ["MissingFile.hs"] $ do
output <- EL.consume
sendTest t $ last output @?= (ToolPrompt "")
executeGhciCommand tool ":quit" $ do
output <- EL.consume
sendTest t $ output `check` [
ToolInput ":quit",
ToolOutput "Leaving GHCi.",
ToolExit ExitSuccess],
"GHCi" ~: do
t <- newEmptyMVar
tool <- newGhci' [] $ do
output <- EL.consume
sendTest t $ last output @?= (ToolPrompt "")
executeGhciCommand tool ":m +System.IO" $ do
output <- EL.consume
sendTest t $ output `check` [
ToolInput ":m +System.IO",
ToolPrompt ""]
executeGhciCommand tool "hPutStr stderr \"Test\"" $ do
output <- EL.consume
sendTest t $ output `check` [
ToolInput "hPutStr stderr \"Test\"",
ToolError "Test",
ToolPrompt ""]
executeGhciCommand tool "1+1" $ do
output <- EL.consume
sendTest t $ output `check` [
ToolInput "1+1",
ToolOutput "2",
ToolPrompt ""]
executeGhciCommand tool "jfkdfjdkl" $ do
output <- EL.consume
sendTest t $ output `check` [
ToolInput "jfkdfjdkl",
ToolError "",
#if __GLASGOW_HASKELL__ > 702
ToolError "<interactive>:22:1: Not in scope: `jfkdfjdkl'",
#else
ToolError "<interactive>:1:1: Not in scope: `jfkdfjdkl'",
#endif
ToolPrompt ""]
executeGhciCommand tool "\n1+1" $ do
output <- EL.consume
sendTest t $ output `check` [
ToolInput "",
ToolInput "1+1",
ToolOutput "2",
ToolPrompt ""]
executeGhciCommand tool ":m + Prelude" $ do
output <- EL.consume
sendTest t $ output `check` [
ToolInput ":m + Prelude",
ToolPrompt ""]
executeGhciCommand tool "\njfkdfjdkl" $ do
output <- EL.consume
sendTest t $ output `check` [
ToolInput "",
ToolInput "jfkdfjdkl",
ToolError "",
#if __GLASGOW_HASKELL__ > 702
ToolError "<interactive>:37:1: Not in scope: `jfkdfjdkl'",
#else
ToolError "<interactive>:1:1: Not in scope: `jfkdfjdkl'",
#endif
ToolPrompt ""]
executeGhciCommand tool "do\n putStrLn \"1\"\n putStrLn \"2\"\n putStrLn \"3\"\n putStrLn \"4\"\n putStrLn \"5\"\n" $ do
output <- EL.consume
sendTest t $ output `check` [
ToolInput "do",
ToolInput " putStrLn \"1\"",
ToolInput " putStrLn \"2\"",
ToolInput " putStrLn \"3\"",
ToolInput " putStrLn \"4\"",
ToolInput " putStrLn \"5\"",
ToolOutput "1",
ToolOutput "2",
ToolOutput "3",
ToolOutput "4",
ToolOutput "5",
ToolPrompt ""]
executeGhciCommand tool "do\n putStrLn \"| 1\"\n putStrLn \"| 2\"\n putStrLn \"| 3\"\n putStrLn \"| 4\"\n putStrLn \"| 5\"\n" $ do
output <- EL.consume
sendTest t $ output `check` [
ToolInput "do",
ToolInput " putStrLn \"| 1\"",
ToolInput " putStrLn \"| 2\"",
ToolInput " putStrLn \"| 3\"",
ToolInput " putStrLn \"| 4\"",
ToolInput " putStrLn \"| 5\"",
ToolOutput "| 1",
ToolOutput "| 2",
ToolOutput "| 3",
ToolOutput "| 4",
ToolOutput "| 5",
ToolPrompt ""]
executeGhciCommand tool "putStr \"ABC\"" $ do
output <- EL.consume
sendTest t $ output `check` [
ToolInput "putStr \"ABC\"",
ToolPrompt "ABC"]
executeGhciCommand tool ":m +Data.List" $ do
output <- EL.consume
sendTest t $ output `check` [
ToolInput ":m +Data.List",
ToolPrompt ""]
executeGhciCommand tool ":quit" $ do
output <- EL.consume
sendTest t $ output `check` [
ToolInput ":quit",
ToolOutput "Leaving GHCi.",
ToolExit ExitSuccess]
runTests t]
main :: IO ()
main = do
args <- getArgs
case args of
[] -> do
updateGlobalLogger rootLoggerName (\ l -> setLevel DEBUG l)
(Counts{failures=failures}, _) <- runTestText (putTextToHandle stderr False) tests
if failures == 0
then exitSuccess
else exitFailure
["ExitSuccess"] -> exitSuccess
["Exit42"] -> exitWith (ExitFailure 42)
["BlankLine", o] -> hPutStrLn (h o) ""
["Hello", o] -> hPutStrLn (h o) "Hello World"
["ErrAndOut"] -> hPutStrLn stderr "Error" >> hPutStrLn stdout "Output"
["Unterminated", o] -> hPutStr (h o) "Unterminated"
_ -> exitFailure
where
h "StdErr" = stderr
h _ = stdout