diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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/ diff --git a/goldplate.cabal b/goldplate.cabal --- a/goldplate.cabal +++ b/goldplate.cabal @@ -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 Maintainer: Jasper Van der Jeugt -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 diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -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