Merge pull request #56 from SamirTalwar/bless-missing-files

SamirTalwar · web-flow · commit 88bc8169ead3 · 2020-10-08T12:26:49.000+02:00
diff --git a/fixtures/broken-specs/smoke.yaml b/fixtures/broken-specs/smoke.yaml
@@ -2,12 +2,14 @@ tests:
   - name: no-command
 
   - name: no-outputs
-    command: echo
+    command:
+      - echo
     args:
       - input
 
   - name: missing-input-file
-    command: echo
+    command:
+      - echo
     args:
       - something
     stdin:
@@ -16,15 +18,15 @@ tests:
       output
 
   - name: missing-output-file
-    command: echo
+    command:
+      - echo
     args:
-      - something
+      - "This is some standard output."
     stdout:
       file: io/missing.out
 
   - name: missing-error-file
-    command: echo
-    args:
-      - something
+    command: |
+      echo "This is some standard error.">&2
     stderr:
       file: io/missing.err
diff --git a/spec/bless.yaml b/spec/bless.yaml
@@ -19,6 +19,16 @@ tests:
     revert:
       - ../fixtures/calculator
 
+  - name: bottles
+    args:
+      - --bless
+      - fixtures/bottles
+    exit-status: 1
+    stdout:
+      file: io/bottles-bless-failure.out
+    revert:
+      - ../fixtures/bottles
+
   - name: files
     args:
       - --bless
@@ -33,12 +43,23 @@ tests:
     revert:
       - ../fixtures/files
 
-  - name: bottles
+  - name: broken-specs
     args:
       - --bless
-      - fixtures/bottles
+      - fixtures/broken-specs
     exit-status: 1
     stdout:
-      file: io/bottles-bless-failure.out
+      - file: io/broken-specs-bless-failure.out-unix
+      - file: io/broken-specs-bless-failure.out-windows
+    files:
+      - path: ../fixtures/broken-specs/io/missing.out
+        contents: |
+          This is some standard output.
+      - path: ../fixtures/broken-specs/io/missing.err
+        contents:
+          - |
+            This is some standard error.
+          - |
+            "This is some standard error."
     revert:
-      - ../fixtures/bottles
+      - ../fixtures/broken-specs
diff --git a/spec/io/broken-specs-bless-failure.out-unix b/spec/io/broken-specs-bless-failure.out-unix
@@ -0,0 +1,12 @@
+no-command
+  There is no command.
+no-outputs
+  There are no STDOUT or STDERR values, or files, in the specification.
+missing-input-file
+  The fixture "io/missing.in" does not exist.
+missing-output-file
+  succeeded
+missing-error-file
+  succeeded
+
+5 tests, 3 failures
diff --git a/spec/io/broken-specs-bless-failure.out-windows b/spec/io/broken-specs-bless-failure.out-windows
@@ -0,0 +1,12 @@
+no-command
+  There is no command.
+no-outputs
+  There are no STDOUT or STDERR values, or files, in the specification.
+missing-input-file
+  The fixture "io\missing.in" does not exist.
+missing-output-file
+  succeeded
+missing-error-file
+  succeeded
+
+5 tests, 3 failures
diff --git a/spec/io/broken-specs.out-unix b/spec/io/broken-specs.out-unix
@@ -5,8 +5,13 @@ no-outputs
 missing-input-file
   The fixture "io/missing.in" does not exist.
 missing-output-file
-  The fixture "io/missing.out" does not exist.
+  args:   This is some standard output.
+  stdout: 
+    The fixture "io/missing.out" does not exist.
+    actual: This is some standard output.
 missing-error-file
-  The fixture "io/missing.err" does not exist.
+  stderr: 
+    The fixture "io/missing.err" does not exist.
+    actual: This is some standard error.
 
 5 tests, 5 failures
diff --git a/spec/io/broken-specs.out-windows b/spec/io/broken-specs.out-windows
@@ -5,8 +5,13 @@ no-outputs
 missing-input-file
   The fixture "io\missing.in" does not exist.
 missing-output-file
-  The fixture "io\missing.out" does not exist.
+  args:   This is some standard output.
+  stdout: 
+    The fixture "io\missing.out" does not exist.
+    actual: This is some standard output.
 missing-error-file
-  The fixture "io\missing.err" does not exist.
+  stderr: 
+    The fixture "io\missing.err" does not exist.
+    actual: "This is some standard error."
 
 5 tests, 5 failures
diff --git a/src/app/Test/Smoke/App/PrintErrors.hs b/src/app/Test/Smoke/App/PrintErrors.hs
@@ -30,9 +30,9 @@ printTestError (PlanningError NoInput) =
 printTestError (PlanningError NoOutput) =
   printError
     "There are no STDOUT or STDERR values, or files, in the specification."
-printTestError (PlanningError (NonExistentFixture path)) =
+printTestError (PlanningError (PlanningFixtureFileError (MissingFile path))) =
   printError $ "The fixture " <> showPath path <> " does not exist."
-printTestError (PlanningError (CouldNotReadFixture path exception)) =
+printTestError (PlanningError (PlanningFixtureFileError (CouldNotReadFile path exception))) =
   printErrorWithException exception $
     "The fixture " <> showPath path <> " could not be read."
 printTestError (PlanningError (PlanningFilterError filterError)) =
diff --git a/src/app/Test/Smoke/App/PrintResults.hs b/src/app/Test/Smoke/App/PrintResults.hs
@@ -92,17 +92,30 @@ printFailureName (LongName name) _ = do
 failureIsInline :: AssertionFailure a -> Bool
 failureIsInline AssertionFailureDiff {} = True
 failureIsInline AssertionFailureContains {} = False
-failureIsInline AssertionFailureFileError {} = True
+failureIsInline AssertionFailureExpectedFileError {} = True
+failureIsInline AssertionFailureActualFileError {} = True
 
 printFailure :: FixtureType a => AssertionFailure a -> Output ()
-printFailure (AssertionFailureDiff expected actual) = printDiff (serializeFixture expected) (serializeFixture actual)
-printFailure (AssertionFailureContains expected actual) = do
+printFailure (AssertionFailureDiff (Expected expected) (Actual actual)) =
+  printDiff (serializeFixture expected) (serializeFixture actual)
+printFailure (AssertionFailureContains (Expected expected) (Actual actual)) = do
   putPlainLn ""
   putRedLn "    expected to contain:"
   putRedLn $ indentedAll nestedOutputIndentation (serializeFixture expected)
   putRed "    actual: "
   putRedLn $ indented nestedOutputIndentation (serializeFixture actual)
-printFailure (AssertionFailureFileError (SmokeFileError exception)) = do
+printFailure (AssertionFailureExpectedFileError fileError (Actual actual)) = do
+  printFailureFileError fileError
+  putRed "    actual: "
+  putRedLn $ indented nestedOutputIndentation (serializeFixture actual)
+printFailure (AssertionFailureActualFileError fileError) =
+  printFailureFileError fileError
+
+printFailureFileError :: SmokeFileError -> Output ()
+printFailureFileError (MissingFile path) = do
+  putPlainLn ""
+  putRedLn $ "    The fixture " <> showPath path <> " does not exist."
+printFailureFileError (CouldNotReadFile _ exception) = do
   putRedLn $ fromString (ioeGetErrorString exception)
 
 printDiff :: Text -> Text -> Output ()
diff --git a/src/lib/Test/Smoke/Assert.hs b/src/lib/Test/Smoke/Assert.hs
@@ -36,22 +36,24 @@ processOutputs location testPlan@(TestPlan _ _ fallbackShell _ _ _ expectedStatu
     assertEqual :: Eq a => a -> a -> EqualityResult a
     assertEqual expected actual
       | expected == actual = EqualitySuccess
-      | otherwise = EqualityFailure expected actual
+      | otherwise = EqualityFailure (Expected expected) (Actual actual)
 
     assert :: Assert a -> a -> Asserting (Maybe (AssertionFailure a))
     assert (AssertEquals expected) actual =
       return $
         if expected == actual
           then Nothing
-          else Just $ AssertionFailureDiff expected actual
+          else Just $ AssertionFailureDiff (Expected expected) (Actual actual)
     assert (AssertContains expected) actual =
       return $
         if Text.isInfixOf (serializeFixture expected) (serializeFixture actual)
           then Nothing
-          else Just $ AssertionFailureContains expected actual
+          else Just $ AssertionFailureContains (Expected expected) (Actual actual)
     assert (AssertFiltered fixtureFilter expected) actual = do
       filteredActual <- withExceptT AssertionFilterError $ applyFilters fallbackShell fixtureFilter actual
       assert expected filteredActual
+    assert (AssertFileError fileError) actual =
+      return $ Just $ AssertionFailureExpectedFileError fileError (Actual actual)
 
     assertAll :: Vector (Assert a) -> a -> Asserting (AssertionResult a)
     assertAll expecteds actual = do
@@ -62,7 +64,7 @@ processOutputs location testPlan@(TestPlan _ _ fallbackShell _ _ _ expectedStatu
     assertFile assertions (ActualFileContents contents) =
       assertAll assertions contents
     assertFile _ (ActualFileError fileError) =
-      return . AssertionFailure . SingleAssertionFailure $ AssertionFailureFileError fileError
+      return . AssertionFailure . SingleAssertionFailure $ AssertionFailureActualFileError fileError
 
     collapseAssertionFailures :: Vector (AssertionFailure a) -> AssertionFailures a
     collapseAssertionFailures failures =
diff --git a/src/lib/Test/Smoke/Bless.hs b/src/lib/Test/Smoke/Bless.hs
@@ -19,7 +19,7 @@ import Test.Smoke.Paths
 import Test.Smoke.Types
 
 blessResult :: ResolvedPath Dir -> TestResult -> IO TestResult
-blessResult _ (TestResult TestPlan {planTest = test} (EqualityFailure _ (Status actualStatus)) _ _ _) =
+blessResult _ (TestResult TestPlan {planTest = test} (EqualityFailure _ (Actual (Status actualStatus))) _ _ _) =
   failed test $ CouldNotBlessInlineFixture "status" (Text.pack (show actualStatus))
 blessResult location result@(TestResult TestPlan {planTest = test} _ stdOut stdErr files) =
   do
@@ -40,6 +40,7 @@ blessResult location result@(TestResult TestPlan {planTest = test} _ stdOut stdE
     writeFixture Nothing _ before =
       return before
     writeFixture (Just (path, text)) makeAfter before = do
+      createParent (location </> path)
       writeToPath (location </> path) text
       return $ makeAfter AssertionSuccess before
 blessResult _ result = return result
@@ -57,13 +58,17 @@ serialize outputs (AssertionFailure result) =
       throwIO $ CouldNotBlessWithMultipleValues (fixtureName @a)
 
 serializeFailure :: forall a. FixtureType a => TestOutput a -> AssertionFailures a -> IO (Maybe (RelativePath File, Text))
-serializeFailure (TestOutput _ (FileLocation path)) (SingleAssertionFailure (AssertionFailureDiff _ actual)) =
+serializeFailure (TestOutput _ (FileLocation path)) (SingleAssertionFailure (AssertionFailureDiff _ (Actual actual))) =
   return $ Just (path, serializeFixture actual)
-serializeFailure (TestOutput _ (Inline _)) (SingleAssertionFailure (AssertionFailureDiff _ actual)) =
+serializeFailure (TestOutput _ (Inline _)) (SingleAssertionFailure (AssertionFailureDiff _ (Actual actual))) =
   throwIO $ CouldNotBlessInlineFixture (fixtureName @a) (serializeFixture actual)
-serializeFailure (TestOutput _ _) (SingleAssertionFailure (AssertionFailureContains _ actual)) =
+serializeFailure (TestOutput _ _) (SingleAssertionFailure (AssertionFailureContains _ (Actual actual))) =
   throwIO $ CouldNotBlessContainsAssertion (fixtureName @a) (serializeFixture actual)
-serializeFailure (TestOutput _ _) (SingleAssertionFailure (AssertionFailureFileError _)) =
+serializeFailure (TestOutput _ (FileLocation path)) (SingleAssertionFailure (AssertionFailureExpectedFileError _ (Actual actual))) =
+  return $ Just (path, serializeFixture actual)
+serializeFailure (TestOutput _ (Inline _)) (SingleAssertionFailure (AssertionFailureExpectedFileError _ (Actual actual))) =
+  throwIO $ CouldNotBlessInlineFixture (fixtureName @a) (serializeFixture actual)
+serializeFailure (TestOutput _ _) (SingleAssertionFailure (AssertionFailureActualFileError _)) =
   return Nothing
 serializeFailure _ (MultipleAssertionFailures _) =
   throwIO $ CouldNotBlessWithMultipleValues (fixtureName @a)
diff --git a/src/lib/Test/Smoke/Execution.hs b/src/lib/Test/Smoke/Execution.hs
@@ -11,8 +11,7 @@ import qualified Data.Map.Strict as Map
 import Data.Vector (Vector)
 import qualified Data.Vector as Vector
 import System.Directory
-  ( createDirectory,
-    doesDirectoryExist,
+  ( doesDirectoryExist,
     removeDirectoryRecursive,
   )
 import System.Exit (ExitCode (..))
@@ -51,7 +50,7 @@ executeTest location (TestPlan _ workingDirectory _ executable args processStdIn
       let absolutePath = location </> path
       contents <-
         either
-          (ActualFileError . SmokeFileError)
+          (ActualFileError . CouldNotReadFile path)
           (ActualFileContents . TestFileContents)
           <$> tryIOError (readFromPath absolutePath)
       return (absolutePath, contents)
@@ -70,7 +69,7 @@ revertingDirectory path execution = do
     result <- execution
     tryIO (CouldNotRevertDirectory path) $ do
       removeDirectoryRecursive filePath
-      createDirectory filePath
+      createDirectory path
       Tar.extract filePath tarFile
     return result
 
diff --git a/src/lib/Test/Smoke/Paths.hs b/src/lib/Test/Smoke/Paths.hs
@@ -10,6 +10,8 @@ module Test.Smoke.Paths
     ResolvedPath,
     PathError (..),
     (</>),
+    createDirectory,
+    createParent,
     findExecutable,
     findFilesInPath,
     getCurrentWorkingDirectory,
@@ -165,6 +167,12 @@ readFromPath = Text.IO.readFile . toFilePath
 writeToPath :: ResolvedPath File -> Text -> IO ()
 writeToPath = Text.IO.writeFile . toFilePath
 
+createDirectory :: ResolvedPath Dir -> IO ()
+createDirectory = Directory.createDirectoryIfMissing True . toFilePath
+
+createParent :: ResolvedPath File -> IO ()
+createParent = createDirectory . parent
+
 -- Errors
 data PathError
   = CouldNotFindExecutable (RelativePath File)
diff --git a/src/lib/Test/Smoke/Plan.hs b/src/lib/Test/Smoke/Plan.hs
@@ -5,6 +5,7 @@ where
 
 import Control.Applicative ((<|>))
 import Control.Monad (forM, when)
+import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Except (ExceptT (..), runExceptT, throwE, withExceptT)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
@@ -111,16 +112,16 @@ readFiles location test = mapM (mapM (readTestOutput location)) (testFiles test)
 
 readTestInput :: ResolvedPath Dir -> Maybe Shell -> TestInput a -> Planning a
 readTestInput location _ (TestInput contents) =
-  readContents location contents
+  withExceptT PlanningFixtureFileError $ readContents location contents
 readTestInput location fallbackShell (TestInputFiltered fixtureFilter contents) = do
-  value <- readContents location contents
+  value <- withExceptT PlanningFixtureFileError $ readContents location contents
   withExceptT PlanningFilterError $ applyFilters fallbackShell fixtureFilter value
 
 readTestOutput :: ResolvedPath Dir -> TestOutput a -> Planning (Assert a)
 readTestOutput location (TestOutput constructor contents) =
-  constructor <$> readContents location contents
+  liftIO (either AssertFileError constructor <$> runExceptT (readContents location contents))
 
-readContents :: ResolvedPath Dir -> Contents a -> Planning a
+readContents :: ResolvedPath Dir -> Contents a -> ExceptT SmokeFileError IO a
 readContents _ (Inline value) =
   return value
 readContents location (FileLocation path) =
@@ -129,8 +130,8 @@ readContents location (FileLocation path) =
       (handleMissingFileError path)
       (ExceptT $ tryIOError $ readFromPath (location </> path))
 
-handleMissingFileError :: RelativePath File -> IOError -> SmokePlanningError
+handleMissingFileError :: RelativePath File -> IOError -> SmokeFileError
 handleMissingFileError path e =
   if isDoesNotExistError e
-    then NonExistentFixture path
-    else CouldNotReadFixture path e
+    then MissingFile path
+    else CouldNotReadFile path e
diff --git a/src/lib/Test/Smoke/Types/Assert.hs b/src/lib/Test/Smoke/Types/Assert.hs
@@ -13,14 +13,22 @@ data Assert a where
   AssertEquals :: Eq a => a -> Assert a
   AssertContains :: FixtureType a => a -> Assert a
   AssertFiltered :: FixtureType a => Filter -> Assert a -> Assert a
+  AssertFileError :: SmokeFileError -> Assert a
 
 instance (Default a, Eq a) => Default (Assert a) where
   def = AssertEquals def
 
+newtype Expected a = Expected a
+  deriving (Functor)
+
+newtype Actual a = Actual a
+  deriving (Functor)
+
 data AssertionFailure a
-  = AssertionFailureDiff a a
-  | AssertionFailureContains a a
-  | AssertionFailureFileError SmokeFileError
+  = AssertionFailureDiff (Expected a) (Actual a)
+  | AssertionFailureContains (Expected a) (Actual a)
+  | AssertionFailureExpectedFileError SmokeFileError (Actual a)
+  | AssertionFailureActualFileError SmokeFileError
   deriving (Functor)
 
 data AssertionFailures a
diff --git a/src/lib/Test/Smoke/Types/Errors.hs b/src/lib/Test/Smoke/Types/Errors.hs
@@ -29,8 +29,7 @@ data SmokePlanningError
   = NoCommand
   | NoInput
   | NoOutput
-  | NonExistentFixture (RelativePath File)
-  | CouldNotReadFixture (RelativePath File) IOError
+  | PlanningFixtureFileError SmokeFileError
   | PlanningPathError PathError
   | PlanningFilterError SmokeFilterError
   deriving (Show)
@@ -71,7 +70,7 @@ data SmokeFilterError
 
 instance Exception SmokeFilterError
 
-newtype SmokeFileError = SmokeFileError IOError
+data SmokeFileError = MissingFile (RelativePath File) | CouldNotReadFile (RelativePath File) IOError
   deriving (Show)
 
 instance Exception SmokeFileError
diff --git a/src/lib/Test/Smoke/Types/Results.hs b/src/lib/Test/Smoke/Types/Results.hs
