proctest 0.1.0.1 → 0.1.2.0

raw patch · 3 files changed

+76/−10 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Test/Proctest.hs +30/−7
• Test/Proctest/Assertions.hs +42/−0
• proctest.cabal +4/−3

@@ -65,6 +65,8 @@   -- * Running and stopping programs , run+, RunException (..)+, isRunning , terminateProcesses , closeHandles @@ -116,13 +118,34 @@ -- -- Directly runs the process, does not use a shell. ----- Sets the 'BufferMode to 'LineBuffering'.+-- Sets the 'BufferMode to 'LineBuffering' if successful.+--+-- Throws 'CommandNotFound' if the command doesn't exist.+-- Due to 'createProcess' not throwing an exception+-- (<http://www.haskell.org/pipermail/haskell-cafe/2012-August/102824.html>),+-- this is currently implemented by checking if the program+-- returns early with error code 127. run :: FilePath -> [String] -> IO (Handle, Handle, Handle, ProcessHandle) run cmd args = do-  r@(i, o, e, _) <- runInteractiveProcess cmd args Nothing Nothing-  setBuffering LineBuffering [i, o, e]-  return r+  r@(i, o, e, p) <- runInteractiveProcess cmd args Nothing Nothing+  getProcessExitCode p >>= \me -> case me of+    -- TODO see if we can make runInteractiveProcess throw the exception instead+    Just (ExitFailure 127) -> throwIO $ CommandNotFound cmd+    _                      -> do+      setBuffering LineBuffering [i, o, e]+      return r +-- | Exception to be thrown when a program could not be started.+data RunException = CommandNotFound String+                  | ExitedTooEarly String+                    deriving (Show, Typeable)++instance Exception RunException++-- | Tells whether the given process is still running.+isRunning :: ProcessHandle -> IO Bool+isRunning p = do x <- getProcessExitCode p; return (x == Nothing)+ -- | Terminates all processes in the list. terminateProcesses :: [ProcessHandle] -> IO () terminateProcesses = mapM_ terminateProcess@@ -132,7 +155,7 @@ closeHandles = mapM_ hClose  --- | A microsecnd timeout, or 'NoTimeout'.+-- | A microsecond timeout, or 'NoTimeout'. data Timeout = NoTimeout | Micros Int  -- | An error to be thrown if something is to be converted into timeout@@ -141,7 +164,7 @@  instance Exception InvalidTimeoutError --- | Turns the given number of microsecnds into a 'Timeout'.+-- | Turns the given number of microseconds into a 'Timeout'. -- -- Throws an exception on 'Int' overflow. mkTimeoutUs :: Integer -> Timeout@@ -173,7 +196,7 @@ -- -- Example: @(seconds 0.2)@ are roughly @Micros 200000@. seconds :: Float -> Timeout-seconds s = mkTimeoutUs (round $ s * 10000000)+seconds s = mkTimeoutUs (round $ s * 1000000)   -- | Suspends execution for the given timeout; uses 'threadDelay' internally.

@@ -0,0 +1,42 @@+{- | Helpers for asserting certain things for programs, using HUnit.++All of the assertions in this module throw HUnit exceptions on failure+using `assertFailure`.+-}++module Test.Proctest.Assertions (+  -- * Starting programs+    runAssert++) where+++import Test.Proctest+import Test.HUnit+++-- | Performs the monadic action on the contents of the `Just`, if any.+onJust :: (Monad m) => (a -> m ()) -> Maybe a -> m ()+onJust = maybe (return ())++-- | Runs the given program with `run` and asserts that it is still running+-- after the given timeout.+--+-- Don't choose the timeout too high as this function will block for it.+--+-- If the timeout is exceeded, a HUnit `assertFailure` exception is thrown,+-- showing the command line to be invoked, the exit code, and the standard+-- error output of the program.+runAssert :: Timeout -> FilePath -> [String] -> IO (Handle, Handle, Handle, ProcessHandle)+runAssert timeout cmd args = do+  r@(_, _, hErr, p) <- run cmd args+  sleep timeout+  getProcessExitCode p >>= (onJust $ \ec -> do+    -- The lazy IO here is OK, as we immediately show the String afterwards.+    err <- hGetContents hErr+    assertFailure $ "The program '" ++ program ++ "' after being started immediately "+                    ++ "exited with exit code " ++ show ec ++ ".\n"+                    ++ "--- stderr: ---\n" ++ err ++ "\n--- End of stderr ---")+  return r+  where+    program = cmd ++ concatMap (" " ++) args

@@ -1,5 +1,5 @@ name:          proctest-version:       0.1.0.1+version:       0.1.2.0 license:       MIT license-file:  LICENSE author:        Niklas Hambüchen@@ -29,12 +29,14 @@ library   default-language: Haskell2010   exposed-modules:-    Test.Proctest+      Test.Proctest+    , Test.Proctest.Assertions   build-depends:       base >= 4 && <= 5     , process >= 1.1.0.1     , bytestring     , text+    , HUnit   ghc-options:     -Wall @@ -55,4 +57,3 @@     , QuickCheck >= 2.4.2   ghc-options:     -threaded -fwarn-unused-imports-