hcltest 0.1 → 0.2
raw patch · 6 files changed
+102/−153 lines, 6 filesdep −concurrent-extradep −lifted-basedep ~basedep ~bytestringdep ~directory
Dependencies removed: concurrent-extra, lifted-base
Dependency ranges changed: base, bytestring, directory, dlist, doctest, either, filepath, free, lens, mmorph, monad-control, mtl, optparse-applicative, process, random-shuffle, split, stm, tagged, tasty, temporary, text, transformers, transformers-base
Files
- .travis.yml +8/−23
- hcltest.cabal +55/−74
- src/Test/HClTest.hs +1/−1
- src/Test/HClTest/Monad.hs +14/−32
- src/Test/HClTest/Program.hs +21/−20
- src/Test/Tasty/HClTest.hs +3/−3
.travis.yml view
@@ -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
hcltest.cabal view
@@ -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 <benno.fuenfstueck@gmail.com>-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 <benno.fuenfstueck@gmail.com>+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+
src/Test/HClTest.hs view
@@ -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
src/Test/HClTest/Monad.hs view
@@ -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
src/Test/HClTest/Program.hs view
@@ -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
src/Test/Tasty/HClTest.hs view
@@ -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