diff --git a/.travis.yml b/.travis.yml --- a/.travis.yml +++ b/.travis.yml @@ -1,37 +1,22 @@ -# The following enables several GHC versions to be tested; often it's enough to test only against the last release in a major GHC version. Feel free to omit lines listings versions you don't need/want testing for. env: - GHCVER=7.4.2 CABALVER=1.16 - GHCVER=7.6.3 CABALVER=1.18 - - GHCVER=head # see section about GHC HEAD snapshots + - GHCVER=7.8.2 CABALVER=1.18 before_install: - sudo add-apt-repository -y ppa:hvr/ghc - sudo apt-get update - - sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER happy hlint - - export PATH=/opt/ghc/$GHCVER/bin:$PATH + - sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER hlint + - cabal-$CABALVER update + - cabal-$CABALVER install happy -j + - export PATH=/opt/ghc/$GHCVER/bin:~/.cabal/bin:$PATH install: - - cabal-$CABALVER update - cabal-$CABALVER install --only-dependencies --enable-tests --enable-benchmarks -j script: - - cabal-$CABALVER configure --enable-tests --enable-benchmarks -v2 --ghc-options="-Wall -Werror" - - cabal-$CABALVER build - - cabal-$CABALVER test - - cabal-$CABALVER check - - hlint src - - cabal-$CABALVER sdist # tests that a source-distribution can be generated - -# The following scriptlet checks that the resulting source distribution can be built & installed - - export SRC_TGZ=$(cabal-$CABALVER info . | awk '{print $2 ".tar.gz";exit}') ; - cd dist/; - if [ -f "$SRC_TGZ" ]; then - cabal-$CABALVER install "$SRC_TGZ"; - else - echo "expected '$SRC_TGZ' not found"; - exit 1; - fi + - travis/script.sh + - hlint src matrix: - allow_failures: - - env: GHCVER=head + fast_finish: true diff --git a/hcltest.cabal b/hcltest.cabal --- a/hcltest.cabal +++ b/hcltest.cabal @@ -1,77 +1,58 @@ -name: hcltest -version: 0.1 -license: BSD3 -cabal-version: >= 1.10 -license-file: LICENSE -author: Benno Fünfstück -maintainer: Benno Fünfstück -stability: experimental -homepage: http://github.com/bennofs/hcltest/ -bug-reports: http://github.com/bennofs/hcltest/issues -copyright: Copyright (C) 2013 Benno Fünfstück -synopsis: A testing library for command line applications. -description: Allows to write tests for command line applications using haskell. -category: Testing -build-type: Custom - -extra-source-files: - .ghci - .gitignore - .travis.yml - .vim.custom - README.md - +name: hcltest +version: 0.2 +cabal-version: >=1.10 +build-type: Custom +license: BSD3 +license-file: LICENSE +copyright: Copyright (C) 2013 Benno Fünfstück +maintainer: Benno Fünfstück +stability: experimental +homepage: http://github.com/bennofs/hcltest/ +bug-reports: http://github.com/bennofs/hcltest/issues +synopsis: A testing library for command line applications. +description: Allows to write tests for command line applications using haskell. +category: Testing +author: Benno Fünfstück +data-dir: "" +extra-source-files: .ghci .gitignore .travis.yml .vim.custom + README.md + source-repository head - type: git - location: git://github.com/bennofs/hcltest.git - + type: git + location: git://github.com/bennofs/hcltest.git + library - hs-source-dirs: src - default-language: Haskell2010 - ghc-options: -Wall - build-depends: - base >= 4.4 && < 5 - , bytestring - , text - , free - , process - , filepath - , transformers >= 0.1.3.0 - , either - , directory - , dlist - , temporary - , mtl - , lens - , tasty - , tagged - , mmorph - , random-shuffle - , split - , stm - , optparse-applicative - , monad-control - , lifted-base - , transformers-base - , concurrent-extra - exposed-modules: - Test.HClTest - Test.HClTest.Program - Test.HClTest.Monad - Test.HClTest.Setup - Test.HClTest.Trace - Test.Tasty.HClTest - + build-depends: base >=4.6.0.1 && <4.7, + bytestring >=0.10.0.2 && <0.11, text >=0.11.3.1 && <0.12, + free >=4.5 && <4.7, process >=1.1.0.2 && <1.2, + filepath >=1.3.0.1 && <1.4, transformers >=0.3.0.0 && <0.4, + either >=4.1.1 && <4.2, directory >=1.2.0.1 && <1.3, + dlist >=0.6.0.1 && <0.8, temporary >=1.2.0.1 && <1.3, + mtl >=2.1.2 && <2.2, lens >=4.0.7 && <4.2, tasty >=0.8.0.2 && <0.9, + tagged >=0.7.1 && <0.8, mmorph >=1.0.2 && <1.1, + random-shuffle >=0.0.4 && <0.1, split >=0.2.2 && <0.3, + stm >=2.4.2 && <2.5, optparse-applicative >=0.7.0.2 && <0.9, + monad-control >=0.3.2.3 && <0.4, transformers-base >=0.4.1 && <0.5 + exposed-modules: Test.HClTest Test.HClTest.Program + Test.HClTest.Monad Test.HClTest.Setup Test.HClTest.Trace + Test.Tasty.HClTest + exposed: True + buildable: True + default-language: Haskell2010 + hs-source-dirs: src + ghc-options: -Wall + test-suite doctests - type: exitcode-stdio-1.0 - main-is: doctests.hs - default-language: Haskell2010 - build-depends: - base - , directory >= 1.0 - , doctest >= 0.9.1 - , filepath - ghc-options: -Wall -threaded - if impl(ghc<7.6.1) - ghc-options: -Werror - hs-source-dirs: tests + build-depends: base >=4.6.0.1 && <4.7, directory >=1.2.0.1 && <1.3, + doctest >=0.9.10.2 && <0.10, filepath >=1.3.0.1 && <1.4 + + if impl(ghc <7.6.1) + buildable: True + ghc-options: -Werror + type: exitcode-stdio-1.0 + main-is: doctests.hs + buildable: True + default-language: Haskell2010 + hs-source-dirs: tests + ghc-options: -Wall -threaded + diff --git a/src/Test/HClTest.hs b/src/Test/HClTest.hs --- a/src/Test/HClTest.hs +++ b/src/Test/HClTest.hs @@ -3,7 +3,7 @@ ) where import Test.HClTest.Monad as X (Config(), HClTest()) -import Test.HClTest.Monad as X hiding (wdLock, timeoutFactor, Config, HClTest) +import Test.HClTest.Monad as X hiding (timeoutFactor, Config, HClTest) import Test.HClTest.Program as X import Test.HClTest.Setup as X import Test.HClTest.Trace as X diff --git a/src/Test/HClTest/Monad.hs b/src/Test/HClTest/Monad.hs --- a/src/Test/HClTest/Monad.hs +++ b/src/Test/HClTest/Monad.hs @@ -3,7 +3,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} -- | This module defines the basic test type, HClTest, which is a monad. It also provides functions --- for creating and running tests. +-- for creating and running tests. module Test.HClTest.Monad ( HClTest(..) , Config(..) @@ -14,16 +14,12 @@ , traceMsg , testIO , randomParallel - , withWorkingDirectory , timeoutFactor - , wdLock ) where import Control.Applicative import Control.Concurrent -import qualified Control.Concurrent.RLock as RLock import Control.Concurrent.STM -import Control.Exception.Lifted import Control.Lens import Control.Monad.Base import Control.Monad.IO.Class @@ -37,15 +33,13 @@ import Data.List import Data.List.Split import System.Directory -import System.FilePath import System.IO.Temp import System.Random.Shuffle import Test.HClTest.Trace --- | The config is passed in a Reader to the test cases. -data Config = Config - { _wdLock :: RLock.RLock - , _timeoutFactor :: Double +-- | The config is passed in a Reader to the test cases. +data Config = Config + { _timeoutFactor :: Double } makeLenses ''Config @@ -60,13 +54,14 @@ data StM (HClTest w) a = HClTestSt { unHClTestSt :: StM (ReaderT Config (MaybeT (WriterT (DL.DList w) IO))) a } liftBaseWith f = HClTest $ liftBaseWith (\k -> f (fmap HClTestSt . k . unHClTest )) restoreM = HClTest . restoreM . unHClTestSt - -- | Run a HClTest. The first argument is the timeout for waiting for output -- of the process, in milliseconds. The second argument is the test case. -- -- This will run the test in a temporary working directory. Use the functions -- in Test.HClTest.Setup to setup the environment. +-- +-- Returns True when the test succeeded, False otherwise. runHClTestTrace :: Double -> HClTest Trace () -> IO (Bool, DL.DList Trace) runHClTestTrace tf (HClTest a) = runWriterT $ do @@ -75,9 +70,7 @@ liftIO $ setCurrentDirectory tmp tell $ pure $ Trace "Change to temporary directory" ["Working directory is now: " ++ tmp ++ "\n"] - wdLockVar <- liftIO RLock.new - s <- has _Just <$> runMaybeT (runReaderT a $ Config wdLockVar tf) - + s <- has _Just <$> runMaybeT (runReaderT a $ Config tf) when s $ liftIO $ removeDirectoryRecursive tmp tell $ pure $ Trace (if s then "Removed temporary directory" else "Temporary directory not removed") [] @@ -88,7 +81,7 @@ -- | Like runHClTestTrace, but already shows the trace so that you get a string. runHClTest :: Double -> HClTest Trace () -> IO (Bool,String) runHClTest tf a = runHClTestTrace tf a & mapped._2 %~ unlines . map showTrace . DL.toList - + -- | This is a HClTest action that always fails. The first argument is the trace to leave. -- If you want to fail without leaving a trace, you can just use 'mzero'. failTest :: a -> HClTest a b @@ -103,7 +96,7 @@ testIO :: String -> IO Bool -> HClTest Trace () testIO desc action = testStep ("Test :: " ++ desc) $ do success <- liftIO action - unless success $ failTest "Failed" + unless success $ failTest "Failed" -- | A single test step. The first argument is a description of the step. The test step -- can produce trace messages of type 'String'. Those will be collected an exactly one @@ -116,8 +109,7 @@ b <$ tell (pure $ Trace desc $ DL.toList w) -- | Run a number of tests in parallel, in random order. The first argument is the number of threads --- to use. Note that if the test cases require different working directories, some of the threads --- may block. +-- to use. randomParallel :: Int -> [HClTest Trace ()] -> HClTest Trace () randomParallel n tests = do @@ -131,23 +123,13 @@ liftIO $ for_ workLoads $ \workLoad -> forkIO $ do void $ runMaybeT $ for_ workLoad $ \test -> do (c,_) <- liftIO $ readTVarIO resultVar - guard $ getAll c + guard $ getAll c (s,t) <- liftIO $ runWriterT $ fmap (has _Just) $ runMaybeT $ flip runReaderT settings $ unHClTest test liftIO $ atomically $ modifyTVar' resultVar (<> (All s,t)) liftIO $ atomically $ modifyTVar' nfinishedVar pred - + liftIO $ atomically $ readTVar nfinishedVar >>= check . (== 0) (success, trac) <- liftIO $ readTVarIO resultVar - - HClTest $ tell trac - guard $ getAll success --- | Run a test in the given directory. -withWorkingDirectory :: FilePath -> HClTest Trace a -> HClTest Trace a -withWorkingDirectory path a = do - pwd <- liftIO getCurrentDirectory - lock <- view wdLock - liftIO $ RLock.acquire lock - liftIO $ setCurrentDirectory path - traceMsg $ Trace "Change working directory" ["Working directory is now: " ++ show (pwd path) ++ "\n"] - a `finally` liftIO (setCurrentDirectory pwd >> RLock.release lock) + HClTest $ tell trac + guard $ getAll success diff --git a/src/Test/HClTest/Program.hs b/src/Test/HClTest/Program.hs --- a/src/Test/HClTest/Program.hs +++ b/src/Test/HClTest/Program.hs @@ -31,10 +31,10 @@ import Test.HClTest.Monad import Test.HClTest.Trace --- | A output stream. +-- | A output stream. data Stream = Stdout | Stderr deriving Show --- | This is the functor from which the free monad Driver is generated. +-- | This is the functor from which the free monad Driver is generated. -- It is an enumeration of possible primitive operations possible in the Driver monad. data DriverF a = MatchStream Stream T.Text a | SendInput T.Text a @@ -58,7 +58,7 @@ -- | Check that the process' output ended. expectEOF :: Stream -> Driver () expectEOF = liftF . flip ExpectEOF () - + -- | Run a driver. The first argument is the timeout for waiting for output of the process. -- The second argument are handles to stdin, stdout and stderr of the process. The third -- argument is the driver to run. This produces a test step. @@ -98,7 +98,7 @@ streamH Stdout = stdoutH matchFailure :: T.Text -> ByteString -> T.Text -> T.Text -> HClTest String a - matchFailure ex got e desc = failTest $ T.unpack $ T.unlines + matchFailure ex got e desc = failTest $ T.unpack $ T.unlines [ "- Match failure -" , "Expected: " <> ex , "Got: " <> T.decodeUtf8 got <> e @@ -111,10 +111,10 @@ tryGetTimeout h time m = runEitherT $ do eof <- lift (hIsEOF h) when eof $ left (True,BS.empty) - + hasInput <- lift $ hWaitForInput h time unless hasInput $ left (False,BS.empty) - + inp <- lift $ BS.hGetNonBlocking h m if BS.length inp < m then do @@ -122,7 +122,7 @@ either left right $ n & _Left._2 %~ mappend inp else return inp --- | Read all available data from a handle. The first argument is a timeout for waiting for output. +-- | Read all available data from a handle. The first argument is a timeout for waiting for output. -- If the process outputs nothing for more than timeout milliseconds, that is considered end of output. hReadAvailable :: Int -> Handle -> IO BS.ByteString hReadAvailable time h = do @@ -138,12 +138,12 @@ else return BS.empty -- | Make a test step for an interactive program. The first argument is either the working directory --- or Nothing, which doesn't change the working directory. The second argument is the timeout in seconds +-- or Nothing, which doesn't change the working directory. The second argument is the timeout in seconds -- for waiting for output of the process. The third argument is the executable file. The forth argument -- are the arguments for the executable and the fifth is the driver to use. The driver should return -- the expected exit code. -testInteractive :: Maybe FilePath -> Int -> FilePath -> [String] -> Driver ExitCode -> HClTest Trace () -testInteractive wd time prog args driver = do +testInteractive :: Maybe FilePath -> Maybe [(String, String)] -> Int -> FilePath -> [String] -> Driver ExitCode -> HClTest Trace () +testInteractive wd envs time prog args driver = do let cmdline = prog ++ " " ++ unwords args (Just stdinH, Just stdoutH, Just stderrH, p) <- liftIO $ createProcess (proc prog args) @@ -151,9 +151,10 @@ , std_out = CreatePipe , std_err = CreatePipe , cwd = wd + , env = envs } - testStep ("Run command :: " ++ cmdline ++ maybe "" (\x -> " [WD: " ++ x ++ "]") wd) $ do + testStep ("Run command :: " ++ cmdline ++ maybe "" (\x -> " [WD: " ++ x ++ "]") wd) $ do exitCode <- runDriver time (stdinH,stdoutH,stderrH) driver @@ -162,13 +163,13 @@ err <- liftIO $ hReadAvailable time stderrH traceMsg $ T.unpack $ T.decodeUtf8 out traceMsg $ T.unpack $ T.decodeUtf8 err - + exitCode' <- liftIO $ timeout (time * 1000) $ waitForProcess p - liftIO $ when (isNothing exitCode') $ terminateProcess p - + liftIO $ when (isNothing exitCode') $ terminateProcess p + case exitCode' of Nothing -> failTest "- Process didn't exit -\n" - Just exitCode'' -> + Just exitCode'' -> unless (exitCode'' == exitCode) $ failTest $ unlines [ "- Exit code didn't match - " , "Expected: " ++ show exitCode @@ -177,12 +178,12 @@ return () --- | A restricted form of testInteractive that Only tests that the process produces the given output on stderr, and no more. See +-- | A restricted form of testInteractive that Only tests that the process produces the given output on stderr, and no more. See -- 'testInteractive' for a description of the arguments. -testStdout :: Maybe FilePath -> Int -> FilePath -> [String] -> ExitCode -> T.Text -> HClTest Trace () -testStdout wd time prog args exit out = testInteractive wd time prog args $ exit <$ expect Stdout out <* expectEOF Stdout +testStdout :: Maybe FilePath -> Maybe [(String, String)] -> Int -> FilePath -> [String] -> ExitCode -> T.Text -> HClTest Trace () +testStdout wd envs time prog args exit out = testInteractive wd envs time prog args $ exit <$ expect Stdout out <* expectEOF Stdout -- | A restricted form of testInteractive that only tests that the process exits with the given exit code. -- See 'testInteractive' for a description of the arguments. -testExitCode :: Maybe FilePath -> Int -> FilePath -> [String] -> ExitCode -> HClTest Trace () -testExitCode wd time prog args = testInteractive wd time prog args . return +testExitCode :: Maybe FilePath -> Maybe [(String, String)] -> Int -> FilePath -> [String] -> ExitCode -> HClTest Trace () +testExitCode wd envs time prog args = testInteractive wd envs time prog args . return diff --git a/src/Test/Tasty/HClTest.hs b/src/Test/Tasty/HClTest.hs --- a/src/Test/Tasty/HClTest.hs +++ b/src/Test/Tasty/HClTest.hs @@ -40,11 +40,11 @@ , Option (Proxy :: Proxy HClTestSuccessLog) ] - run opts (HClTasty t) _ = fmap toResult $ runHClTest factor t + run opts (HClTasty t) _ = toResult <$> runHClTest factor t where HClTestTimeoutFactor factor = lookupOption opts HClTestSuccessLog sl = lookupOption opts - toResult (True,l) = Result True $ if sl then l else "" - toResult (False,l) = Result False l + toResult (True,l) = testPassed $ if sl then l else "" + toResult (False,l) = testFailed l -- | Make a new test case with the given name using a HClTest for testing. hcltest :: TestName -> HClTest Trace () -> TestTree