proctest (empty) → 0.1.0.0

raw patch · 5 files changed

+497/−0 lines, 5 filesdep +HUnitdep +QuickCheckdep +basesetup-changed

Dependencies added: HUnit, QuickCheck, base, bytestring, hspec, process, smartcheck, text

Files

• LICENSE +7/−0
• Setup.hs +2/−0
• Test/Proctest.hs +226/−0
• examples/netcat-test.hs +203/−0
• proctest.cabal +59/−0

@@ -0,0 +1,7 @@+Copyright (C) 2012 Niklas Hambuechen++Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,226 @@+{-# LANGUAGE DeriveDataTypeable #-}++{- | An IO library for testing interactive command line programs.++Read this first:++  - Tests using Proctests need to be compiled with @-threaded@ for not blocking on process spawns.++  - Beware that the Haskell GC closes process 'Handle's after their last use.+    If you don't want to be surprised by this, use 'hClose' where you want+    them to be closed (convenience: 'closeHandles').++  - Make sure handle buffering is set appropriately.+    'run' sets 'LineBuffering' by default.+    Change it with 'setBuffering' or 'hSetBuffering'.++  - Do not run the program in a shell (e.g. 'runInteractiveCommand') if you want to+    be able to terminate it reliably ('terminateProcess'). Use processes without shells+    ('runInteractiveProcess') instead.+++Example:++Let's say you want to test an interactive command line program like @cat@,+and integrate your test into a test framework like "Test.HSpec",+using "Test.HSpec.HUnit" for the IO parts (remember that Proctest /is/ stateful IO).++> main = hspec $ describe "cat" $ do+>+>   it "prints out what we put in" $ do+>+>     -- Start up the program to test+>     (hIn, hOut, hErr, p) <- run "cat" []+>+>     -- Make sure buffering doesn't prevent us from reading what we expect+>     -- ('run' sets LineBuffering by default)+>     setBuffering NoBuffering [hIn, hOut]+>+>     -- Communicate with the program+>     hPutStrLn hIn "hello world"+>+>     -- Define a convenient wrapper around 'waitOutput'.+>     --+>     -- It specifies how long we have to wait+>     -- (malfunctioning programs shall not block automated testing for too long)+>     -- and how many bytes we are sure the expected response fits into+>     -- (malfunctioning programs shall not flood us with garbage either).+>     let catWait h = asUtf8Str <$> waitOutput (seconds 0.01) 1000 h -- Wait max 10 ms, 1000 bytes+>+>     -- Wait a little to allow `cat` processing the input+>     sleep (seconds 0.00001)+>+>     -- Read the response+>     response <- catWait hOut+>+>     -- Test if it is what we want (here using HUnit's 'expectEqual')+>     response @?= "hello world\n"++-}++module Test.Proctest (+  -- * String conversion+  asUtf8+, asUtf8Str++ -- * Running and stopping programs+, run+, terminateProcesses+, closeHandles++-- * Timeouts+, Timeout (NoTimeout)+, InvalidTimeoutError+, mkTimeoutUs+, mkTimeoutMs+, mkTimeoutS+, seconds++-- * Communicating with programs+, TimeoutException+, waitOutput+, waitOutputNoEx+, setBuffering+, sleep++-- * Convenience module exports+, module System.Exit+, module System.IO+, module System.Process+) where++import Control.Concurrent (threadDelay)+import Control.Exception (Exception (..), throw, throwIO)+import Data.Text+import Data.Text.Encoding (decodeUtf8)+import Data.Typeable+import qualified Data.ByteString as BS+import System.Exit+import System.IO+import System.Process+import System.Timeout (timeout)+++-- | Treats a 'BS.ByteString' as UTF-8 decoded 'Text'.+asUtf8 :: BS.ByteString -> Text+asUtf8 = decodeUtf8++-- | Treats a 'BS.ByteString' as UTF-8 decoded 'String'.+asUtf8Str :: BS.ByteString -> String+asUtf8Str = unpack . asUtf8+++-- | Runs a program with the given arguemtns.+--+-- Returns @(stdout, stderr, stdin, process)@. See 'runInteractiveProcess'.+--+-- Directly runs the process, does not use a shell.+--+-- Sets the 'BufferMode to 'LineBuffering'.+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++-- | Terminates all processes in the list.+terminateProcesses :: [ProcessHandle] -> IO ()+terminateProcesses = mapM_ terminateProcess++-- | Closes all handles in the list.+closeHandles :: [Handle] -> IO ()+closeHandles = mapM_ hClose+++-- | A microsecnd timeout, or 'NoTimeout'.+data Timeout = NoTimeout | Micros Int++-- | An error to be thrown if something is to be converted into timeout+-- that does not fit into 'Int'.+data InvalidTimeoutError = InvalidTimeoutError String deriving (Show, Typeable)++instance Exception InvalidTimeoutError++-- | Turns the given number of microsecnds into a 'Timeout'.+--+-- Throws an exception on 'Int' overflow.+mkTimeoutUs :: Integer -> Timeout+mkTimeoutUs n+  | n <= 0                             = NoTimeout+  | n > fromIntegral (maxBound :: Int) = throw $ InvalidTimeoutError msg+  | otherwise                          = Micros (fromIntegral n)+  where+    msg = "Test.Proctest.Timeout: " ++ show n ++ " microseconds do not fit into Int"+++-- | Turns the given number of milliseconds into a 'Timeout'.+--+-- Throws an exception on 'Int' overflow.+mkTimeoutMs :: (Integral a) => a -> Timeout+mkTimeoutMs = mkTimeoutUs . (* 1000) . fromIntegral+++-- | Turns the given number of seconds into a 'Timeout'.+--+-- Throws an exception on 'Int' overflow.+mkTimeoutS :: (Integral a) => a -> Timeout+mkTimeoutS = mkTimeoutUs . (* 1000000) . fromIntegral+++-- | Turns floating seconds into a 'Timeout'.+--+-- Throws an exception on 'Int' overflow.+--+-- Example: @(seconds 0.2)@ are roughly @Micros 200000@.+seconds :: Float -> Timeout+seconds s = mkTimeoutUs (round $ s * 10000000)+++-- | Suspends execution for the given timeout; uses 'threadDelay' internally.+-- For 'NoTimeout', threadDelay will not be called.+sleep :: Timeout -> IO ()+sleep t = case t of+  NoTimeout -> return ()+  Micros n  -> threadDelay n+++-- | Exception to be thrown when a program did not terminate+-- within the expected time.+data TimeoutException = TimeoutException deriving (Show, Typeable)++instance Exception TimeoutException+++-- | Converts a 'Timeout' milliseconds suitable to be passed into 'timeout'.+timeoutToSystemTimeoutArg :: Timeout -> Int+timeoutToSystemTimeoutArg t = case t of+  Micros n  -> n+  NoTimeout -> -1++-- | Blocking wait for output on the given handle.+--+-- Returns 'Nothing' timeout is exceeded.+waitOutputNoEx :: Timeout                   -- ^ Timeout after which reading output will be aborted.+               -> Int                       -- ^ Maximum number of bytes after which reading output will be aborted.+               -> Handle                    -- ^ The handle to read from.+               -> IO (Maybe BS.ByteString)  -- ^ What was read from the handle.+waitOutputNoEx t maxBytes handle =+  timeout (timeoutToSystemTimeoutArg t) (BS.hGetSome handle maxBytes)+++-- | Blocking wait for output on the given handle.+--+-- Throws a 'TimeoutException' if the timeout is exceeded.+--+-- Based on 'waitOutputNoEx'.+waitOutput :: Timeout           -- ^ Timeout after which reading output will be aborted.+           -> Int               -- ^ Maximum number of bytes after which reading output will be aborted.+           -> Handle            -- ^ The handle to read from.+           -> IO BS.ByteString  -- ^ What was read from the handle.+waitOutput t maxBytes handle = let ex = throwIO TimeoutException in+  waitOutputNoEx t maxBytes handle >>= maybe ex return+++-- | Sets the buffering of the all given handles to the given 'BufferMode'.+setBuffering :: BufferMode -> [Handle] -> IO ()+setBuffering bufferMode handles = mapM_ (flip hSetBuffering bufferMode) handles

@@ -0,0 +1,203 @@+module Main where+++import Control.Applicative+import Test.Hspec+import Test.Hspec.QuickCheck+import Test.HUnit+import Test.Proctest+import Test.QuickCheck.Property (morallyDubiousIOProperty)+++-- Example of communicating with `cat`.+--+-- See below for integration with hspec and hunit.+catTest :: IO ()+catTest = do+  (hIn, hOut, hErr, p) <- run "cat" []++  hPutStrLn hIn "test line 1"++  let catWait h = fmap asUtf8Str <$> waitOutputNoEx (seconds 0.01) 1000 h -- Wait max 10 ms, 1000 bytes++  sleep (seconds 0.00001) -- Give cat time to digest++  response <- catWait hOut++  putStrLn $ case response of+    Just x | x == "test line 1\n" -> "cat test successful"+    Just x                        -> "cat test failed. Output was: " ++ show x+    Nothing                       -> "cat timed out, producing no output"++  mExitCode <- getProcessExitCode p++  case mExitCode of+    Just ExitSuccess     -> putStrLn $ "process exited normally"+    Just (ExitFailure n) -> putStrLn $ "process quit with exit code " ++ show n+    Nothing              -> do putStrLn "process did not quit, killing it"+                               terminateProcess p++{-+Some convenience for declaring tests:++  - '?@' for giving the label first, then the monadic action.++  - Separating assertions from their labels:++    -- '?==' creates an assertion++    -- 'label' optionally labels it+-}++infix 1 ?@+(?@) :: (AssertionPredicable t) => String -> t -> Assertion+(?@) = flip (@?)+++data EqualAssertion a = EqualAssertion a a++data LabeledAssertion a = LabeledAssertion String (EqualAssertion a)+++(?==) :: (Eq a, Show a) => a -> a -> EqualAssertion a+actual ?== expected = EqualAssertion actual expected++label :: String -> EqualAssertion a -> LabeledAssertion a+label = LabeledAssertion+++instance (Eq a, Show a) => Assertable (EqualAssertion a) where+  assert (EqualAssertion actual expected) = actual @?= expected++instance (Eq a, Show a) => Assertable (LabeledAssertion a) where+  assert (LabeledAssertion msg (EqualAssertion actual expected)) =+    assertEqual msg actual expected++assertLabel str equalsAssertion = assert (label str equalsAssertion)+++++ncTestHunit = it "does a simple server <-> client interaction (1)" $ do++  (serverIn, serverOut, serverErr, serverP) <- run "nc" ["-l", "1234"]+  (clientIn, clientOut, clientErr, clientP) <- run "nc" ["localhost", "1234"]++  -- Make sure processes are running+  serverExitCode <- getProcessExitCode serverP+  clientExitCode <- getProcessExitCode clientP++  assertLabel "server is running" $ serverExitCode ?== Nothing+  assertLabel "client is running" $ clientExitCode ?== Nothing++  let ncWait h = asUtf8Str <$> waitOutput (seconds 0.01) 100 h++  hPutStrLn clientIn "request 1"+  r <- ncWait serverOut+  assertLabel "server receives client request" $ r ?== "request 1\n"++  hPutStrLn serverIn "response 1"+  r <- ncWait clientOut+  assertLabel "client receives server response" $ r ?== "response 1\n"++  terminateProcesses [serverP, clientP]++++ncTestHunitClean = it "does a simple server <-> client interaction (2)" $ do++  -- Spawn+  (serverIn, serverOut, serverErr, serverP) <- run "nc" ["-l", "1234"]+  (clientIn, clientOut, clientErr, clientP) <- run "nc" ["localhost", "1234"]++  -- Check+  assertProcessesRunning serverP clientP++  -- Buffering+  setBuffering NoBuffering [clientIn, clientOut, serverIn, serverOut]++  -- Send+  assertLabel "server receives client request"  =<< popsOut clientIn serverOut "request 1\n"+  assertLabel "client receives server response" =<< popsOut serverIn clientOut "response 1\n"++  -- Close+  closeHandles [serverIn, serverOut, clientIn, clientOut]+  sleep (seconds 0.001)++  assertLabel "server shut down" =<< assertionExitSuccess serverP++  where+    ncWait h = asUtf8Str <$> waitOutput (seconds 0.01) 100 h++    assertionRunning     proc = (?== Nothing)          <$> getProcessExitCode proc+    assertionExitSuccess proc = (?== Just ExitSuccess) <$> getProcessExitCode proc++    assertProcessesRunning serverP clientP = do+      assertLabel "server is running" =<< assertionRunning serverP+      assertLabel "client is running" =<< assertionRunning clientP++    popsOut hIn hOut content = do+      hPutStr hIn content+      r <- ncWait hOut+      return $ r ?== content++++catSpec = describe "cat" $ do+  it "prints out what we put in" $ do++    -- Start up the program to test+    (hIn, hOut, hErr, p) <- run "cat" []++    -- Make sure buffering doesn't prevent us from reading what we expect+    setBuffering NoBuffering [hIn, hOut]++    -- Communicate with the program+    hPutStrLn hIn "hello world"++    -- Define a convenient wrapper around 'waitOutput'.+    --+    -- It specifies how long we have to wait+    -- (malfunctioning programs shall not block automated testing for too long)+    -- and how many bytes we are sure the expected response fits into+    -- (malfunctioning programs shall not flood us with garbage either).+    let catWait h = asUtf8Str <$> waitOutput (seconds 0.01) 1000 h -- Wait max 10 ms, 1000 bytes++    -- Wait a little to allow `cat` processing the input+    sleep (seconds 0.00001)++    -- Read the response+    response <- catWait hOut++    -- Test if it is what we want (here using HUnit's 'expectEqual')+    response @?= "hello world\n"+++catCheck :: [String] -> IO Bool+catCheck lines = do++  (hIn, hOut, hErr, p) <- run "cat" []++  let catWait h = asUtf8Str <$> waitOutput (seconds 0.01) 1000 h++      checkLine l = do hPutStrLn hIn l+                       sleep (seconds 0.00001)+                       (== (l ++ "\n")) <$> catWait hOut++  and <$> (mapM checkLine lines)+++catProp inputLines = morallyDubiousIOProperty $ catCheck inputLines++catPropSpec = describe "cat QuickCheck test" $ do+  prop "it gives back whatever we put in" catProp++main = do+  -- catTest -- This is not a hspec test.+  hspec $ do+    describe "cat" $ do+      catSpec+      catPropSpec+    describe "netcat" $ do+      ncTestHunit+      ncTestHunitClean

@@ -0,0 +1,59 @@+name:          proctest+version:       0.1.0.0+license:       MIT+license-file:  LICENSE+author:        Niklas Hambüchen+copyright:     Copyright: (c) 2012 Niklas Hambüchen+maintainer:    Niklas Hambüchen <mail@nh2.me>+category:      Testing+stability:     experimental+homepage:      https://github.com/nh2/proctest+bug-reports:   https://github.com/nh2/proctest/issues+synopsis:      An IO library for testing interactive command line programs+description:   An IO library for testing interactive command line programs+               .+               Proctest aims to simplify interacting with and testing+               terminal programs, providing convenience functions+               for starting programs and reading their output.+               .+               All blocking operations support timeouts so that misbehaving+               programs cannot block your test pipeline.+               .+               Find more examples and contribute at+               <https://github.com/nh2/proctest>.++build-type:    Simple+cabal-version: >= 1.10+++library+  default-language: Haskell2010+  exposed-modules:+    Test.Proctest+  build-depends:+      base >= 4 && <= 5+    , process >= 1.1.0.1+    , bytestring+    , text+  ghc-options:+    -Wall+++executable example-netcat-test+  default-language: Haskell2010+  hs-source-dirs:+    ., examples+  main-is:+    netcat-test.hs+  build-depends:+      base >= 4 && <= 5+    , process+    , bytestring+    , text+    , hspec+    , HUnit+    , QuickCheck >= 2.4.2+    , smartcheck+  ghc-options:+    -threaded -fwarn-unused-imports+