goldplate 0.1.3 → 0.2.0
raw patch · 4 files changed
+185/−153 lines, 4 filesdep −timedep ~aesondep ~optparse-applicativedep ~text
Dependencies removed: time
Dependency ranges changed: aeson, optparse-applicative, text
Files
- CHANGELOG.md +4/−0
- README.md +36/−11
- goldplate.cabal +25/−7
- src/Main.hs +120/−135
CHANGELOG.md view
@@ -1,5 +1,9 @@ # CHANGELOG + - 0.2.0 (2021-05-24)+ * Change output to [Test Anything Protocol](https://testanything.org/).+ * Add `working_directory` field (by Beatrice Vergani).+ - 0.1.3 (2021-02-10) * Bump `aeson` dependency upper bound to 1.5. * Bump GHC to 8.10.3.
README.md view
@@ -1,10 +1,12 @@ # goldplate 🏅 $ goldplate -j2 tests/- Found 32 specs- Running 49 executions in 2 jobs- Finished in 0.84s- Ran 32 specs, 49 executions, 146 asserts, all A-OK!+ 1..26+ ok tests/prettify-json.goldplate: exit_code+ ok tests/prettify-json.goldplate: stdout+ ok tests/env.goldplate: exit_code+ ok tests/env.goldplate: stdout+ ... `goldplate` is a cute and simple opaque [golden test] runner for CLI applications. You place your test cases in a directory, annotate them with@@ -22,6 +24,7 @@ At [Fugue](https://fugue.co), we've been using internal versions of this tool since 2016, so it should be pretty stable. +`goldplate` produces output compatible with the [Test Anything Protocol]. ## Table of Contents @@ -30,6 +33,8 @@ - [Feeding input on stdin](#feeding-input-on-stdin) - [Setting environment variables](#setting-environment-variables)+ - [Setting work+ directory](#setting-work-directory) - [Globbing input files](#globbing-input-files) - [Post processing: find and replace](#post-processing-find-and-replace)@@ -82,18 +87,21 @@ invoke `goldplate --fix` to create it: $ goldplate echo.goldplate --pretty-diff --fix- ...- echo.goldplate: stdout: does not match- echo.goldplate: fixed ./hello-world.txt- ...- Ran 1 specs, 1 executions, 2 asserts, 1 failed.+ 1..2+ ok echo.goldplate: exit_code+ not ok echo.goldplate: stdout+ diff:+ 0a1+ > Hello, world!+ fixed ./hello-world.txt After `hello-world.txt` has been created with proper contents, subsequent `goldplate` invocations will pass: $ goldplate echo.goldplate- ...- Ran 1 specs, 1 executions, 2 asserts, all A-OK!+ 1..2+ ok echo.goldplate: exit_code+ ok echo.goldplate: stdout You can view the full example here: @@ -132,6 +140,22 @@ We found this to be good practice, it makes mass-renaming of tests much easier. +### Setting work directory++View example:++ - [`tests/work-dir.goldplate`](tests/work-dir.goldplate)+ - [`tests/work-dir.stdout`](tests/work-dir.stdout)++The `working_directory` field can be used to set the work directory in which the+command will be executed. It can either be an absolute path or a path relative+to the `goldplate` file. If a `working_directory` is specified then the other+fields like `input_files` and `stdout` need to be relative to the+`working_directory` as well.++If a work directory is not specified the `command` will be executed in the+same directory as the `goldplate` file.+ ### Globbing input files View example:@@ -255,3 +279,4 @@ [golden test]: https://ro-che.info/articles/2017-12-04-golden-tests [stack]: https://docs.haskellstack.org/en/stable/README/ [smoke]: https://github.com/SamirTalwar/smoke+[Test Anything Protocol]: http://testanything.org/
goldplate.cabal view
@@ -1,24 +1,43 @@ Name: goldplate-Version: 0.1.3+Version: 0.2.0 Synopsis: A lightweight golden test runner License: Apache-2.0 License-file: LICENSE Author: Jasper Van der Jeugt <jasper@fugue.co> Maintainer: Jasper Van der Jeugt <jasper@fugue.co>-Copyright: 2019-2020 Fugue, Inc+Copyright: 2019-2021 Fugue, Inc+Homepage: https://github.com/fugue/goldplate+Bug-reports: https://github.com/fugue/goldplate/issues Category: Language Build-type: Simple Cabal-version: 1.18+Description: Language-agnostic golden test runner for command-line applications. +Tested-with:+ GHC == 9.0.1+ GHC == 8.10.4+ GHC == 8.8.4+ GHC == 8.6.5+ GHC == 8.4.4+ Extra-source-files: CHANGELOG.md README.md +Source-repository head+ type: git+ location: git://github.com/fugue/goldplate.git++Source-repository this+ type: git+ location: git://github.com/fugue/goldplate.git+ tag: v0.2.0+ Executable goldplate Hs-source-dirs: src Main-is: Main.hs Default-language: Haskell2010- Ghc-options: -Wall -rtsopts -threaded -O2+ Ghc-options: -Wall -rtsopts -threaded Other-modules: Text.Regex.PCRE.Simple@@ -29,15 +48,14 @@ aeson >= 1.4 && < 1.6, aeson-pretty >= 0.8 && < 0.9, async >= 2.2 && < 2.3,- base >= 4.9 && < 5,- bytestring >= 0.10 && < 0.11,+ base >= 4.11 && < 5,+ bytestring >= 0.10 && < 0.12, Diff >= 0.3 && < 0.5, directory >= 1.3 && < 1.4, filepath >= 1.4 && < 1.5, Glob >= 0.10 && < 0.11,- optparse-applicative >= 0.14 && < 0.16,+ optparse-applicative >= 0.14 && < 0.17, process >= 1.6 && < 1.7, regex-pcre-builtin >= 0.95.1.3 && < 0.96, text >= 1.2 && < 1.3,- time >= 1.8 && < 1.10, unordered-containers >= 0.2 && < 0.3
src/Main.hs view
@@ -12,12 +12,10 @@ ) where import Control.Applicative ((<|>))-import Control.Concurrent (threadDelay) import qualified Control.Concurrent.Async as Async import qualified Control.Concurrent.MVar as MVar import Control.Exception (finally, throwIO)-import Control.Monad (forM, forM_, forever, mzero, unless,- when)+import Control.Monad (forM, forM_, mzero, unless, when) import qualified Data.Aeson as A import qualified Data.Aeson.Encode.Pretty as Aeson.Pretty import Data.Algorithm.Diff@@ -31,8 +29,6 @@ import qualified Data.List as List import qualified Data.Text as T import qualified Data.Text.Encoding as T-import Data.Time (NominalDiffTime, diffUTCTime,- getCurrentTime) import Data.Version (showVersion) import qualified Options.Applicative as OA import Paths_goldplate (version)@@ -43,7 +39,6 @@ import qualified System.FilePath.Glob as Glob import qualified System.IO as IO import qualified System.Process as Process-import Text.Printf (printf) import qualified Text.Regex.PCRE.Simple as Pcre import Text.Splice @@ -71,6 +66,7 @@ , specArguments :: ![a] , specStdin :: !(Maybe (Multiple a)) , specEnv :: ![(a, a)]+ , specWorkDir :: !(Maybe a) , specAsserts :: ![Assert a] } deriving (Foldable, Functor, Traversable) @@ -81,6 +77,7 @@ <*> o A..:? "arguments" A..!= [] <*> o A..:? "stdin" <*> (maybe [] HMS.toList <$> o A..:? "environment")+ <*> o A..:? "working_directory" <*> o A..: "asserts" --------------------------------------------------------------------------------@@ -165,18 +162,21 @@ -------------------------------------------------------------------------------- --- | Embarrassingly simple logger.-type Logger = Verbosity -> [String] -> IO ()--data Verbosity = Debug | Message | Error- deriving (Eq, Ord)+data Logger = Logger+ { logDebug :: [String] -> IO ()+ , logError :: [String] -> IO ()+ , logOut :: [String] -> IO ()+ } makeLogger :: Bool -> IO Logger makeLogger verbose = do lock <- MVar.newMVar ()- return $ \verbosity msgs ->- unless (not verbose && verbosity == Debug) $- MVar.withMVar lock $ \() -> mapM_ (IO.hPutStrLn IO.stderr) msgs+ let writeLines h ls = MVar.withMVar lock $ \() -> mapM_ (IO.hPutStrLn h) ls+ return Logger+ { logDebug = if verbose then writeLines IO.stderr else \_ -> pure ()+ , logError = writeLines IO.stderr+ , logOut = writeLines IO.stdout+ } -------------------------------------------------------------------------------- @@ -192,15 +192,22 @@ specExecutions :: FilePath -> Spec String -> IO [Execution] specExecutions specPath spec = do+ absoluteSpecPath <- Dir.makeAbsolute specPath let (specDirectory, specBaseName) = FP.splitFileName specPath specName = FP.dropExtension specBaseName + mkAbsoluteWorkDir :: FilePath -> FilePath+ mkAbsoluteWorkDir dir | FP.isRelative dir = specDirectory FP.</> dir+ | otherwise = dir++ workDirectory = maybe specDirectory mkAbsoluteWorkDir (specWorkDir spec) + -- Compute initial environment to get input files. env0 <- getEnvironment let env1 = List.nubBy ((==) `on` fst) $ ("GOLDPLATE_NAME", specName) :- ("GOLDPLATE_FILE", specBaseName) :+ ("GOLDPLATE_FILE", absoluteSpecPath) : ("GOLDPLATE_BASENAME", specBaseName) : specEnv spec ++ env0 @@ -209,7 +216,7 @@ Nothing -> return [Nothing] Just glob0 -> do glob <- hoistEither $ splice env1 glob0- inputFiles <- Dir.withCurrentDirectory specDirectory $ do+ inputFiles <- Dir.withCurrentDirectory workDirectory $ do matches <- globCurrentDir glob length matches `seq` return matches return (map (Just . FP.normalise) inputFiles)@@ -233,12 +240,13 @@ , executionInputFile = mbInputFile , executionSpecPath = specPath , executionSpecName = specName- , executionDirectory = specDirectory+ , executionDirectory = workDirectory } where hoistEither :: Either MissingEnvVar a -> IO a hoistEither = either throwIO return + executionHeader :: Execution -> String executionHeader execution = executionSpecPath execution ++@@ -249,17 +257,12 @@ -------------------------------------------------------------------------------- data Env = Env- { envLogger :: !Logger- , envDiff :: !Bool- , envPrettyDiff :: !Bool- , envFix :: !Bool- , envCountAsserts :: !(IORef.IORef Int)- , envCountFailures :: !(IORef.IORef Int)+ { envLogger :: !Logger+ , envDiff :: !Bool+ , envPrettyDiff :: !Bool+ , envFix :: !Bool } -incrementCount :: IORef.IORef Int -> IO ()-incrementCount ref = IORef.atomicModifyIORef' ref (\x -> (x + 1, ()))- data ExecutionResult = ExecutionResult { erExitCode :: !ExitCode , erStdout :: !B.ByteString@@ -267,10 +270,10 @@ } deriving (Show) runExecution- :: Env -> Execution -> IO ()+ :: Env -> Execution -> IO ExecutionResult runExecution env execution@Execution {..} = do let Spec {..} = executionSpec- envLogger env Debug [executionHeader execution ++ "running..."]+ logDebug (envLogger env) [executionHeader execution ++ "running..."] -- Create a "CreateProcess" description. let createProcess = (Process.proc specCommand specArguments)@@ -282,7 +285,7 @@ } -- Actually run the process.- envLogger env Debug [executionHeader execution +++ logDebug (envLogger env) [executionHeader execution ++ specCommand ++ " " ++ unwords specArguments] (Just hIn, Just hOut, Just hErr, hProc) <- Process.createProcess createProcess@@ -300,33 +303,44 @@ !exitCode <- Async.wait exitAsync !actualOut <- Async.wait outAsync !actualErr <- Async.wait errAsync- let executionResult = ExecutionResult- { erExitCode = exitCode- , erStdout = actualOut- , erStderr = actualErr- }+ logDebug (envLogger env)+ [ executionHeader execution ++ "finished"+ , "exit code: " ++ show exitCode+ , "stdout:", show actualOut+ , "stderr:", show actualErr+ ]+ pure ExecutionResult+ { erExitCode = exitCode+ , erStdout = actualOut+ , erStderr = actualErr+ } - -- Dump stderr/stdout if in debug.- envLogger env Debug [executionHeader execution ++ "finished"]- envLogger env Debug [executionHeader execution ++ "stdout:", show actualOut]- envLogger env Debug [executionHeader execution ++ "stderr:", show actualErr]+-------------------------------------------------------------------------------- - -- Perform checks.- envLogger env Debug [executionHeader execution ++ "checking assertions..."]- forM_ specAsserts $ runAssert env execution executionResult- envLogger env Debug [executionHeader execution ++ "done"]+data AssertResult = AssertResult+ { arOk :: Bool+ , arHeader :: String+ , arMessage :: [String]+ } deriving (Show) +assertResultToTap :: AssertResult -> [String]+assertResultToTap ar =+ ((if arOk ar then "ok " else "not ok ") ++ arHeader ar) :+ map (" " ++) (concatMap lines $ arMessage ar)+ -- | Check a single assertion.-runAssert :: Env -> Execution -> ExecutionResult -> Assert String -> IO ()+runAssert+ :: Env -> Execution -> ExecutionResult -> Assert String -> IO AssertResult runAssert env execution@Execution {..} ExecutionResult {..} assert = case assert of- ExitCodeAssert expectedExitCode -> do+ ExitCodeAssert expectedExitCode -> let actualExitCode = case erExitCode of ExitSuccess -> 0 ExitFailure c -> c- assertTrue (actualExitCode == expectedExitCode) $- "expected " ++ show expectedExitCode ++- " but got " ++ show actualExitCode+ success = expectedExitCode == actualExitCode in+ pure $ makeAssertResult success+ ["expected " ++ show expectedExitCode +++ " but got " ++ show actualExitCode | not success] StdoutAssert {..} -> checkAgainstFile (inExecutionDir stdoutFilePath) stdoutPostProcess erStdout@@ -337,73 +351,71 @@ CreatedFileAssert {..} -> do let path = inExecutionDir createdFilePath exists <- Dir.doesFileExist path- assertTrue exists $ createdFilePath ++ " was not created"- when exists $ do- case createdFileContents of- Nothing -> return ()+ case exists of+ False -> pure $ makeAssertResult False+ [createdFilePath ++ " was not created"]+ True -> case createdFileContents of+ Nothing -> pure $ makeAssertResult True [] Just expectedPath -> do !actual <- readFileOrEmpty path- checkAgainstFile+ ar <- checkAgainstFile (inExecutionDir expectedPath) createdFilePostProcess actual- Dir.removeFile path- envLogger env Debug [executionHeader execution ++- "removed " ++ createdFilePath]+ Dir.removeFile path+ logDebug (envLogger env)+ [executionHeader execution ++ "removed " ++ path]+ pure ar CreatedDirectoryAssert {..} -> do let path = inExecutionDir createdDirectoryPath exists <- Dir.doesDirectoryExist path- assertTrue exists $ createdDirectoryPath ++ " was not created"- when exists $ do- Dir.removeDirectoryRecursive path- envLogger env Debug [executionHeader execution ++- "removed " ++ createdDirectoryPath]+ case exists of+ False -> pure $ makeAssertResult False+ [createdDirectoryPath ++ " was not created"]+ True -> do+ Dir.removeDirectoryRecursive path+ logDebug (envLogger env)+ [executionHeader execution ++ "removed " ++ path]+ pure $ makeAssertResult True [] where+ makeAssertResult ok = AssertResult ok+ (executionHeader execution ++ describeAssert assert)+ inExecutionDir :: FilePath -> FilePath inExecutionDir fp = if FP.isAbsolute fp then fp else executionDirectory FP.</> fp - checkAgainstFile :: FilePath -> PostProcess -> B.ByteString -> IO ()+ checkAgainstFile+ :: FilePath -> PostProcess -> B.ByteString -> IO AssertResult checkAgainstFile expectedPath processor actual0 = do expected <- readFileOrEmpty expectedPath let !actual1 = postProcess processor actual0- assertTrue (actual1 == expected) "does not match"- when (envDiff env && actual1 /= expected) $ do- envLogger env Message- [ executionHeader execution ++ "expected:"- , show expected- , executionHeader execution ++ "actual:"- , show actual1- ]- let diff :: [Diff [String]] = either (const []) id $ do+ success = actual1 == expected+ shouldFix = envFix env && not success++ diff :: [Diff [String]] = either (const []) id $ do expected' <- T.unpack <$> T.decodeUtf8' expected actual1' <- T.unpack <$> T.decodeUtf8' actual1 return $ getGroupedDiff (lines expected') (lines actual1')- when (envPrettyDiff env && actual1 /= expected && not (null diff)) $ do- envLogger env Message- [ executionHeader execution ++ "diff:"- , ppDiff diff- ]- when (envFix env && actual1 /= expected) $ do- B.writeFile expectedPath actual1- envLogger env Message- [executionHeader execution ++ "fixed " ++ expectedPath] - assertTrue :: Bool -> String -> IO ()- assertTrue test err = do- incrementCount (envCountAsserts env)- if test- then- envLogger env Debug [executionHeader execution ++- describeAssert assert ++ ": OK"]- else do- envLogger env Error [executionHeader execution ++- describeAssert assert ++ ": " ++ err]- incrementCount (envCountFailures env)+ when shouldFix $ B.writeFile expectedPath actual1+ pure . makeAssertResult success . concat $+ [ [ "expected:"+ , show expected+ , "actual:"+ , show actual1+ ]+ | not success && envDiff env+ ] +++ [ [ "diff:", ppDiff diff ]+ | not success && envPrettyDiff env+ ] +++ [ ["fixed " ++ expectedPath] | shouldFix ] + -------------------------------------------------------------------------------- -- | Read a file if it exists, otherwise pretend it's empty.@@ -451,7 +463,7 @@ OA.help "Test files/directories")) <*> OA.switch ( OA.short 'v' <>- OA.help "Be more verbose")+ OA.help "Print debug info") <*> OA.switch ( OA.long "diff" <> OA.help "Show differences in files")@@ -491,15 +503,13 @@ main :: IO () main = do- startTime <- getCurrentTime- options <- OA.execParser parserInfo- env <- Env+ options <- OA.execParser parserInfo+ failed <- IORef.newIORef False+ env <- Env <$> makeLogger (oVerbose options) <*> pure (oDiff options) <*> pure (oPrettyDiff options) <*> pure (oFix options)- <*> IORef.newIORef 0- <*> IORef.newIORef 0 -- Find all specs and decode them. specPaths <- findSpecs (oPaths options)@@ -508,7 +518,7 @@ case errOrSpec of Right !spec -> return (specPath, spec) Left !err -> do- envLogger env Error+ logError (envLogger env) [specPath ++ ": could not parse JSON: " ++ err] exitFailure @@ -516,50 +526,25 @@ -- parallelize this because 'specExecutions' needs to change the working -- directory all the time and that might mess with our tests. let numSpecs = length specs- envLogger env Message ["Found " ++ show numSpecs ++ " specs"]+ logDebug (envLogger env) ["Found " ++ show numSpecs ++ " specs"] executions <- fmap concat $ forM specs $ \(specPath, spec) -> specExecutions specPath spec -- Create a pool full of executions.- let numExecutions = length executions- numJobs = oJobs options- envLogger env Message ["Running " ++ show numExecutions ++- " executions in " ++ show numJobs ++ " jobs"]+ let numJobs = oJobs options+ numAsserts = sum $+ map (length . specAsserts . executionSpec) executions+ logOut (envLogger env) ["1.." ++ show numAsserts] pool <- IORef.newIORef executions - -- Spawn a worker to report progress- progress <- Async.async $ forever $ do- threadDelay $ 10 * 1000 * 1000- remaining <- length <$> IORef.readIORef pool- envLogger env Message $ return $- "Progress: " ++ show (numExecutions - remaining) ++ "/" ++- show numExecutions ++ "..."- -- Spawn some workers to run the executions.- Async.replicateConcurrently_ numJobs $ worker pool (runExecution env)- Async.cancel progress-- -- Tell the time.- endTime <- getCurrentTime- envLogger env Message- ["Finished in " ++ showDiffTime (endTime `diffUTCTime` startTime)]+ Async.replicateConcurrently_ numJobs $ worker pool $ \execution -> do+ executionResult <- runExecution env execution+ forM_ (specAsserts $ executionSpec execution) $ \assert -> do+ assertResult <- runAssert env execution executionResult assert+ unless (arOk assertResult) $ IORef.writeIORef failed True+ logOut (envLogger env) $ assertResultToTap assertResult -- Report summary.- asserts <- IORef.readIORef (envCountAsserts env)- failures <- IORef.readIORef (envCountFailures env)- if failures == 0- then- envLogger env Message [- "Ran " ++ show numSpecs ++ " specs, " ++- show numExecutions ++ " executions, " ++- show asserts ++ " asserts, all A-OK!"]- else do- envLogger env Error [- "Ran " ++ show numSpecs ++ " specs, " ++- show numExecutions ++ " executions, " ++- show asserts ++ " asserts, " ++ show failures ++ " failed."]- exitFailure---showDiffTime :: NominalDiffTime -> String-showDiffTime dt = printf "%.2fs" (fromRational (toRational dt) :: Double)+ hasFailed <- IORef.readIORef failed+ when hasFailed exitFailure