diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,3 @@ +# 0.1.0.0 + +- Initial release. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,13 @@ +Copyright Yuji Yamamoto (c) 2018 + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,22 @@ +# main-tester + +Capture stdout/stderr/exit code, and replace stdin of your main function. + +## Why? + +Against the best practice, I often prefer large, end-to-end (E2E) tests. +Because: + +- E2E tests can directly test your users' requirement. +- E2E tests can detect bugs caused by misassumption of external components + - Which happenes relatively more often than the others, according to my experience. +- I often write small programs where E2E tests are sufficient. + +This library main-tester provides utility functions for E2E testing of your CLI applications. +With main-tester, You can test your apps with arbitrary stdin data, check their output and exit code. + +## Comparison with [silently](https://hackage.haskell.org/package/silently) and [System.IO.Fake](https://hackage.haskell.org/package/imperative-edsl-0.7.1/docs/System-IO-Fake.html) + +- 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!). diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/main-tester.cabal b/main-tester.cabal new file mode 100644 --- /dev/null +++ b/main-tester.cabal @@ -0,0 +1,53 @@ +name: main-tester +version: 0.1.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 +license: Apache-2.0 +license-file: LICENSE +author: Yuji Yamamoto +maintainer: whosekiteneverfly@gmail.com +copyright: 2018 Yuji Yamamoto +category: System, Testing +build-type: Simple +extra-source-files: README.md + , ChangeLog.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Test.Main + , Test.Main.Internal + build-depends: base >= 4.7 && < 5 + , bytestring + , directory + default-language: Haskell2010 + +test-suite main-tester-doctest + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: doctest.hs + build-depends: base + , doctest + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + default-language: Haskell2010 + default-extensions: OverloadedStrings + +test-suite main-tester-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , main-tester + , bytestring + , hspec + , hspec-core + , QuickCheck + , text + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + default-language: Haskell2010 + default-extensions: OverloadedStrings + +source-repository head + type: git + location: https://gitlab.com/igrep/main-tester diff --git a/src/Test/Main.hs b/src/Test/Main.hs new file mode 100644 --- /dev/null +++ b/src/Test/Main.hs @@ -0,0 +1,135 @@ +{-# LANGUAGE RecordWildCards #-} + +module Test.Main + ( -- * Utilities for testing your main function + captureProcessResult + , ProcessResult(..) + , withStdin + + -- ** Re-export from System.Environment + , withArgs + + -- ** Re-export from System.Exit + , ExitCode(..) + ) where + + +import qualified Control.Exception as E +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.IO + ( Handle + , SeekMode(AbsoluteSeek) + , stdin + , stderr + , stdout + , hClose + , hFlush + , hSetBinaryMode + , hGetBuffering + , hSetBuffering + , hGetEncoding + , hSetEncoding + , hSeek + , openBinaryTempFile + , withBinaryFile + , IOMode(ReadMode) + ) + +import Test.Main.Internal (ProcessResult(..)) + + +-- | +-- Capture stdout, stderr, and exit code of the given IO action. +-- +-- >>> let main = putStr "hello" +-- >>> captureProcessResult main +-- ProcessResult {prStdout = "hello", prStderr = "", prExitCode = ExitSuccess} +-- +-- If the IO action exit with error message, the exit code of result is 'ExitFailure'. +-- +-- >>> import System.IO +-- >>> import System.Exit +-- >>> let main = hPutStr stderr "OMG!" >> exitWith (ExitFailure 1) +-- >>> captureProcessResult main +-- ProcessResult {prStdout = "", prStderr = "OMG!", prExitCode = ExitFailure 1} +captureProcessResult :: IO () -> IO ProcessResult +captureProcessResult action = do + tDir <- getTemporaryDirectory + withBinaryTmpFile tDir "test-stdout" $ \(_oPath, oHd) -> + withBinaryTmpFile tDir "test-stderr" $ \(_ePath, eHd) -> + redirectingHandle stdout oHd $ + redirectingHandle stderr eHd $ do + prExitCode <- + either id (const ExitSuccess) <$> E.try action + prStdout <- readFromHead oHd stdout + prStderr <- readFromHead eHd stderr + return ProcessResult {..} + + where + readFromHead tmpH stdH = do + hFlush stdH + hSeek tmpH AbsoluteSeek 0 + B.hGetContents tmpH + + +withBinaryTmpFile :: FilePath -> String -> ((FilePath, Handle) -> IO a) -> IO a +withBinaryTmpFile parent name = + E.bracket + (openBinaryTempFile parent name) + (\(path, hd) -> do + hClose hd + removeFile path `E.catch` doNothing + ) + + where + doNothing :: IOError-> IO () + doNothing _ = return () + + +redirectingHandle :: Handle -> Handle -> IO r -> IO r +redirectingHandle from to action = do + saveEnc <- hGetEncoding from + saveBuf <- hGetBuffering from + let redirect = do + save <- hDuplicate from + hDuplicateTo to from + setEnc to + return save + restore save = do + hDuplicateTo save from + setEnc from + hSetBuffering from saveBuf + + setEnc h = + maybe (hSetBinaryMode h True) (hSetEncoding h) saveEnc + E.bracket redirect restore (const action) + + +-- | +-- Pass the ByteString to stdin of the given IO action. +-- +-- >>> import Data.ByteString.Char8 () +-- >>> :set -XOverloadedStrings +-- >>> let main = putStrLn . reverse =<< getLine +-- >>> withStdin "abcde" main +-- edcba +withStdin :: B.ByteString -> IO a -> IO a +withStdin bs action = + E.bracket + prepareInputFile + removeFile + (\inPath -> + withBinaryFile inPath ReadMode $ \tmpHd -> + redirectingHandle stdin tmpHd action + ) + where + prepareInputFile = do + tDir <- getTemporaryDirectory + E.bracket + (openBinaryTempFile tDir "test-stdin") + (\(_path, hd) -> hClose hd) + (\(path, hd) -> B.hPut hd bs >> return path) diff --git a/src/Test/Main/Internal.hs b/src/Test/Main/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Test/Main/Internal.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} +#if defined(mingw32_HOST_OS) +{-# LANGUAGE RecordWildCards #-} +#endif + +module Test.Main.Internal where + + +import qualified Data.ByteString.Char8 as B +import GHC.Generics (Generic) +import System.Exit (ExitCode) + + + +-- | Used for the result of 'Test.Main.captureProcessResult'. +data ProcessResult = + ProcessResult + { prStdout :: !B.ByteString + , prStderr :: !B.ByteString + , prExitCode :: !ExitCode + } deriving (Eq, Show, Generic) + + +-- | 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) + where + nl = B.concat . B.split '\r' +#else +normalizeNewLines = id +#endif diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,50 @@ +import Control.Monad (mapM_) +import Data.ByteString.Char8 (pack) +import System.Environment (getArgs) +import System.Exit (ExitCode(ExitSuccess, ExitFailure) , exitWith) +import System.IO (stderr, hPutStr) +import Test.Hspec +import Test.Hspec.QuickCheck +import Test.QuickCheck + ( Arbitrary + , arbitrary + , choose + , oneof + , listOf + ) + +import Test.Main +import Test.Main.Internal + + +newtype AExitCode = AExitCode ExitCode deriving Show + +instance Arbitrary AExitCode where + arbitrary = + AExitCode <$> oneof [pure ExitSuccess, ExitFailure <$> choose (1, maxBound)] + + +newtype PrintableAsciiString = + PrintableAsciiString { getPrintableAsciiString :: String } deriving Show + +-- https://en.wikipedia.org/wiki/ASCII#Character_set +instance Arbitrary PrintableAsciiString where + arbitrary = PrintableAsciiString <$> listOf (choose (' ', '~')) + + +main :: IO () +main = hspec $ + describe "Test.Main" $ + prop "passes stdin and arguments to the program, and capture stdin data, stderr data, and exitCode" $ + \(argsA, inDataA, AExitCode eCode) -> do + let args = map getPrintableAsciiString argsA + inData = pack $ getPrintableAsciiString inDataA + testedMain = do + mapM_ putStrLn =<< getArgs + hPutStr stderr =<< getContents + exitWith eCode + + actual <- withStdin inData $ withArgs args $ captureProcessResult testedMain + + normalizeNewLines actual `shouldBe` + normalizeNewLines (ProcessResult (pack $ unlines args) inData eCode) diff --git a/test/doctest.hs b/test/doctest.hs new file mode 100644 --- /dev/null +++ b/test/doctest.hs @@ -0,0 +1,6 @@ +module Main where + +import Test.DocTest + +main :: IO () +main = doctest ["src/Test/Main.hs"]