main-tester 0.1.0.0 → 0.2.0.0

raw patch · 6 files changed

+141/−13 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +8/−0
• README.md +4/−0
• main-tester.cabal +10/−1
• src/Test/Main.hs +62/−6
• src/Test/Main/Internal.hs +13/−2
• test/Spec.hs +44/−4

@@ -1,3 +1,11 @@+# 0.2.0.0++- Breaking change:+    - Add `prException` field to `ProcessResult`.+    - Now `captureProcessResult` catches any exception (including `ExitCode`) thrown by the given action (usually your `main` function).+        - The caught exception is available by `prException` function (except `ExitCode`).+- :new: Add `withEnv` function.+ # 0.1.0.0  - Initial release.

@@ -20,3 +20,7 @@ - Can test exit code of your main. - All input and outputs are strict bytestrings except the command line arguments, which is very important when testing with non-UTF8 input and output. - Currently doesn't support suppressing stdout and stderr (Pull request welcome!).++## Usage++See [the document of `Test.Main` module](https://hackage.haskell.org/package/main-tester/docs/Test-Main.html).

@@ -1,5 +1,5 @@ name:                main-tester-version:             0.1.0.0+version:             0.2.0.0 synopsis:            Capture stdout/stderr/exit code, and replace stdin of your main function. description:         See README.md for detail. homepage:            https://gitlab.com/igrep/main-tester#readme@@ -23,7 +23,16 @@                      , directory   default-language:    Haskell2010 +flag doctest+  description:         Build and run doctest. Turn off to avoid error on some environment.+  default:             False+  manual:              True+ test-suite main-tester-doctest+  if flag(doctest)+    buildable:         True+  else+    buildable:         False   type:                exitcode-stdio-1.0   hs-source-dirs:      test   main-is:             doctest.hs

@@ -5,6 +5,7 @@     captureProcessResult   , ProcessResult(..)   , withStdin+  , withEnv    -- ** Re-export from System.Environment   , withArgs@@ -15,11 +16,12 @@   import qualified Control.Exception as E+import           Control.Monad (mapM, mapM_) import qualified Data.ByteString as B import           GHC.IO.Handle (hDuplicate, hDuplicateTo) import           System.Directory (removeFile, getTemporaryDirectory)-import           System.Environment (withArgs)-import           System.Exit (ExitCode(ExitSuccess))+import           System.Environment (withArgs, setEnv, unsetEnv, lookupEnv)+import           System.Exit (ExitCode(ExitSuccess, ExitFailure)) import           System.IO                    ( Handle                    , SeekMode(AbsoluteSeek)@@ -47,7 +49,7 @@ -- -- >>> let main = putStr "hello" -- >>> captureProcessResult main--- ProcessResult {prStdout = "hello", prStderr = "", prExitCode = ExitSuccess}+-- ProcessResult {prStdout = "hello", prStderr = "", prExitCode = ExitSuccess, prException = Nothing} -- -- If the IO action exit with error message, the exit code of result is 'ExitFailure'. --@@ -55,7 +57,20 @@ -- >>> import System.Exit -- >>> let main = hPutStr stderr "OMG!" >> exitWith (ExitFailure 1) -- >>> captureProcessResult main--- ProcessResult {prStdout = "", prStderr = "OMG!", prExitCode = ExitFailure 1}+-- ProcessResult {prStdout = "", prStderr = "OMG!", prExitCode = ExitFailure 1, prException = Nothing}+--+-- @since 0.2.0.0+-- Since v0.2.0.0, this function catches @SomeException@, not only @ExitCode@+-- to prevent it from losing output when an exception other than @ExitCode@ is thrown.+-- To get the thrown error, use @prException@.+--+-- Note: 'prStderr' doesn't contain the error message of the thrown exception.+-- See the example below.+--+-- >>> import Control.Exception+-- >>> let main = ioError $ userError "OMG!"+-- >>> captureProcessResult main+-- ProcessResult {prStdout = "", prStderr = "", prExitCode = ExitFailure 1, prException = Just user error (OMG!)} captureProcessResult :: IO () -> IO ProcessResult captureProcessResult action = do   tDir <- getTemporaryDirectory@@ -63,8 +78,7 @@     withBinaryTmpFile tDir "test-stderr" $ \(_ePath, eHd) ->       redirectingHandle stdout oHd $         redirectingHandle stderr eHd $ do-          prExitCode <--            either id (const ExitSuccess) <$> E.try action+          (prExitCode, prException) <- captureExitCodeAndException action           prStdout <- readFromHead oHd stdout           prStderr <- readFromHead eHd stderr           return ProcessResult {..}@@ -75,7 +89,17 @@       hSeek tmpH AbsoluteSeek 0       B.hGetContents tmpH +    captureExitCodeAndException act =+      (act >> return (ExitSuccess, Nothing))+        `E.catches` [E.Handler forExitCode, E.Handler forSomeException] +    forExitCode :: ExitCode -> IO (ExitCode, Maybe E.SomeException)+    forExitCode eCode = return (eCode, Nothing)++    forSomeException :: E.SomeException -> IO (ExitCode, Maybe E.SomeException)+    forSomeException ex = return (ExitFailure 1, Just ex)++ withBinaryTmpFile :: FilePath -> String -> ((FilePath, Handle) -> IO a) -> IO a withBinaryTmpFile parent name =   E.bracket@@ -133,3 +157,35 @@         (openBinaryTempFile tDir "test-stdin")         (\(_path, hd) -> hClose hd)         (\(path, hd) -> B.hPut hd bs >> return path)+++-- |+-- Run the given IO action with the specified environment variables set.+-- The environment variables are specified as pairs of @ENV_VAR_NAME@ and @ENV_VAR_VALUE@.+-- If @ENV_VAR_VALUE@ is @Nothing@, the @ENV_VAR_NAME@ is unset with 'unsetEnv'.+--+-- >>> import System.Environment+-- >>> setEnv "ENV_VAR_TO_UNSET"    "value_to_unset"+-- >>> setEnv "ENV_VAR_TO_OVERWRITE" "value_to_overwrite"+-- >>> let main = (print =<< lookupEnv "ENV_VAR_TO_UNSET") >> (print =<< lookupEnv "ENV_VAR_TO_OVERWRITE")+-- >>> withEnv [("ENV_VAR_TO_UNSET", Nothing), ("ENV_VAR_TO_OVERWRITE" , Just "new_value")] main+-- Nothing+-- Just "new_value"+-- >>> main+-- Just "value_to_unset"+-- Just "value_to_overwrite"+withEnv :: [(String, Maybe String)] -> IO a -> IO a+withEnv newVarVals action =+  E.bracket+    (saveReplaces newVarVals)+    replaces+    (const action)++  where+    saveReplaces = mapM $ \varVal@(var, _val) ->+      ((,) <$> pure var <*> lookupEnv var) <* replace varVal++    replaces = mapM_ replace++    replace (var, Just val) = setEnv var val+    replace (var, Nothing)  = unsetEnv var

@@ -7,6 +7,7 @@ module Test.Main.Internal where  +import qualified Control.Exception as E import qualified Data.ByteString.Char8 as B import           GHC.Generics (Generic) import           System.Exit (ExitCode)@@ -19,15 +20,25 @@     { prStdout :: !B.ByteString     , prStderr :: !B.ByteString     , prExitCode :: !ExitCode-    } deriving (Eq, Show, Generic)+    , prException :: !(Maybe E.SomeException)+    } deriving (Show, Generic) +-- NOTE: SomeException is not Eq! So can't derive!+instance Eq ProcessResult where+  pr1 == pr2 =+    prStdout pr1 == prStdout pr2+      && prStderr pr1 == prStderr pr2+      && prStderr pr1 == prStderr pr2+      && prExitCode pr1 == prExitCode pr2+      && fmap show (prException pr1) == fmap show (prException pr2) + -- | Use to avoid errors in related to new line code in tests. --   Currently I use this function only for this module's test. normalizeNewLines :: ProcessResult -> ProcessResult #if defined(mingw32_HOST_OS) normalizeNewLines ProcessResult {..} =-  ProcessResult (nl prStdout) (nl prStderr) (prExitCode)+  ProcessResult (nl prStdout) (nl prStderr) prExitCode prException   where     nl = B.concat . B.split '\r' #else

@@ -1,6 +1,7 @@ import           Control.Monad (mapM_) import           Data.ByteString.Char8 (pack)-import           System.Environment (getArgs)+import qualified Control.Exception as E+import           System.Environment (getArgs, setEnv, lookupEnv) import           System.Exit (ExitCode(ExitSuccess, ExitFailure) , exitWith) import           System.IO (stderr, hPutStr) import           Test.Hspec@@ -34,8 +35,8 @@  main :: IO () main = hspec $-  describe "Test.Main" $-    prop "passes stdin and arguments to the program, and capture stdin data, stderr data, and exitCode" $+  describe "Test.Main" $ do+    prop "passes stdin and arguments to the program, and captures stdin data, stderr data, and exit code" $       \(argsA, inDataA, AExitCode eCode) -> do         let args = map getPrintableAsciiString argsA             inData = pack $ getPrintableAsciiString inDataA@@ -47,4 +48,43 @@         actual <- withStdin inData $ withArgs args $ captureProcessResult testedMain          normalizeNewLines actual `shouldBe`-          normalizeNewLines (ProcessResult (pack $ unlines args) inData eCode)+          normalizeNewLines (ProcessResult (pack $ unlines args) inData eCode Nothing)++    prop "captures stdin data, stderr data, exit code, and thrown exception when the program throws an exception" $+      \(inDataA, errDataA, errorMesage) -> do+        let inData = pack $ getPrintableAsciiString inDataA+            errDataS = getPrintableAsciiString errDataA+            errData = pack errDataS+            testedMain = do+              putStr =<< getContents+              hPutStr stderr errDataS+              _ <- fail errorMesage+              putStrLn "*** THIS SHOULD NOT BE PRINTED! ***"++        actual <- withStdin inData $ captureProcessResult testedMain++        normalizeNewLines actual `shouldBe`+          normalizeNewLines+            ( ProcessResult+                inData+                errData+                (ExitFailure 1)+                (Just $ E.SomeException $ userError errorMesage)+            )++    it "overwrites or deletes the specified environment variables temporarily" $ do+      let vu = "value_to_unset"+          vw = "value_to_overwrite"+          nv = "new_value"++      setEnv "ENV_VAR_TO_UNSET"     vu+      setEnv "ENV_VAR_TO_OVERWRITE" vw++      let action =+            (,) <$> lookupEnv "ENV_VAR_TO_UNSET" <*> lookupEnv "ENV_VAR_TO_OVERWRITE"+      resultMutated <- withEnv+        [("ENV_VAR_TO_UNSET", Nothing), ("ENV_VAR_TO_OVERWRITE", Just nv)]+        action++      resultMutated `shouldBe` (Nothing, Just nv)+      action `shouldReturn` (Just vu, Just vw)