diff --git a/cabal-testsuite/PackageTests/FileDescriptors/cabal.stdout b/cabal-testsuite/PackageTests/FileDescriptors/cabal.stdout index 36c601747dc..e69de29bb2d 100644 --- a/cabal-testsuite/PackageTests/FileDescriptors/cabal.stdout +++ b/cabal-testsuite/PackageTests/FileDescriptors/cabal.stdout @@ -1 +0,0 @@ -# cabal build diff --git a/cabal-testsuite/src/Test/Cabal/Monad.hs b/cabal-testsuite/src/Test/Cabal/Monad.hs index efddae668bc..f1dfade3458 100644 --- a/cabal-testsuite/src/Test/Cabal/Monad.hs +++ b/cabal-testsuite/src/Test/Cabal/Monad.hs @@ -35,9 +35,8 @@ module Test.Cabal.Monad ( testSourceCopyDir, testCabalDir, testUserCabalConfigFile, - testActualFileOut, - testActualFileStdout, - testActualFileStderr, + FileDescriptor(..), + testActualFile, -- * Skipping tests skip, skipIf, @@ -354,36 +353,28 @@ runTestM mode m = withSystemTempDirectory "cabal-testsuite" $ \tmp_dir -> do check_expect accept = do env <- getTestEnv norm_env <- mkNormalizerEnv - let testDiff actual actualNormalized expect expectNormalized = when (words actual /= words expect) $ do - -- First try whitespace insensitive diff - -- let actualNormalized = testNormalizedActualFileStdout env - -- expectNormalized = testNormalizedExpectFileStdout env - liftIO $ writeFile actualNormalized actual - liftIO $ writeFile expectNormalized expect - liftIO $ putStrLn "Actual output differs from expected:" - b <- diff ["-uw"] expectNormalized actualNormalized - unless b . void $ diff ["-u"] expectNormalized actualNormalized - if accept - then do liftIO $ putStrLn "Accepting new output." - liftIO $ writeFileNoCR (testExpectFileStdout env) actual - else liftIO $ exitWith (ExitFailure 1) - -- actualOut <- normalizeOutput norm_env <$> liftIO (readFileOrEmpty (testActualFileOut env)) - -- expectOut <- liftIO $ readFileOrEmpty (testExpectFileOut env) - -- actualStdout <- normalizeOutput norm_env <$> liftIO (readFileOrEmpty (testActualFileStdout env)) - -- expectStdout <- liftIO $ readFileOrEmpty (testExpectFileStdout env) - -- actualStderr <- normalizeOutput norm_env <$> liftIO (readFileOrEmpty (testActualFileStderr env)) - -- expectStderr <- liftIO $ readFileOrEmpty (testExpectFileStderr env) - forM_ - [ (testActualFileOut env, testNormalizedActualFileOut env , testExpectFileOut env , testNormalizedExpectFileOut env) - , (testActualFileStdout env, testNormalizedActualFileStdout env, testExpectFileStdout env, testNormalizedExpectFileStdout env) - , (testActualFileStderr env, testNormalizedActualFileStderr env, testExpectFileStderr env, testNormalizedExpectFileStderr env) - ] $ \(actualFile, actualFileNormalized, expectFile, expectFileNormalized) -> do - exists <- liftIO $ doesFileExist expectFile - liftIO $ print (expectFile, exists) + [Out, Stdout, Stderr] `forM_` \fd -> do + exists <- liftIO $ doesFileExist $ testFile NotNormalized Expect fd env when exists $ do - actualOut <- normalizeOutput norm_env <$> liftIO (readFileOrEmpty actualFile) - expectOut <- liftIO $ readFileOrEmpty expectFile - testDiff actualOut actualFileNormalized expectOut expectFileNormalized + actual <- normalizeOutput norm_env <$> liftIO (readFileOrEmpty (testFile NotNormalized Actual fd env)) + expect <- liftIO $ readFileOrEmpty (testFile NotNormalized Expect fd env) + when (words actual /= words expect) $ do + -- First try whitespace insensitive diff + let + actualFile = testFile Normalized Actual fd env + expectFile = testFile Normalized Expect fd env + liftIO $ do + writeFile expectFile actual + writeFile actualFile expect + putStrLn "Actual output differs from expected:" + b <- diff ["-uw"] expectFile actualFile + unless b . void $ diff ["-u"] expectFile actualFile + liftIO $ + if accept + then do + putStrLn "Accepting new output." + writeFileNoCR (testFile NotNormalized Expect Stdout env) actual + else exitWith (ExitFailure 1) readFileOrEmpty :: FilePath -> IO String readFileOrEmpty f = readFile f `E.catch` \e -> @@ -612,66 +603,23 @@ testCabalDir env = testHomeDir env ".cabal" testUserCabalConfigFile :: TestEnv -> FilePath testUserCabalConfigFile env = testCabalDir env "config" --- data Expected = Expected | Actual --- data Normalized = Normalized | NotNormalized --- data FileDescriptor = Out | Stdout | Stderr - --- testFile :: Expected -> Normalized -> FileDescriptor -> TestEnv -> FilePath --- testFile e n f env = sourceDir testName env <.> suffix --- where --- suffix --- = case e of { Expected -> "comp" ; Actual -> "" } --- <.> case f of { Out -> "out" ; Stdout -> "stdout" ; Stderr -> "stderr" } --- <.> case n of { Normalized -> "normalized" ; NotNormalized -> "" } --- sourceDir = case (e, n) of --- (_, Normalized) -> testWorkDir env --- (Actual, _) -> testWorkDir env --- _ -> testSourceDir env - --- | The file where the expected output of the test lives -testExpectFileOut :: TestEnv -> FilePath -testExpectFileOut env = testSourceDir env testName env <.> "out" - --- | Where we store the actual output -testActualFileOut :: TestEnv -> FilePath -testActualFileOut env = testWorkDir env testName env <.> "comp.out" - --- | The file where the expected output of the test lives -testExpectFileStdout :: TestEnv -> FilePath -testExpectFileStdout env = testSourceDir env testName env <.> "stdout" - --- | Where we store the actual output -testActualFileStdout :: TestEnv -> FilePath -testActualFileStdout env = testWorkDir env testName env <.> "comp.stdout" - --- | The file where the expected output of the test lives -testExpectFileStderr :: TestEnv -> FilePath -testExpectFileStderr env = testSourceDir env testName env <.> "stderr" - --- | Where we store the actual errput -testActualFileStderr :: TestEnv -> FilePath -testActualFileStderr env = testWorkDir env testName env <.> "comp.stderr" - --- | Where we will write the normalized actual file (for diffing) -testNormalizedActualFileOut :: TestEnv -> FilePath -testNormalizedActualFileOut env = testActualFileOut env <.> "normalized" - --- | Where we will write the normalized expected file (for diffing) -testNormalizedExpectFileOut :: TestEnv -> FilePath -testNormalizedExpectFileOut env = testWorkDir env testName env <.> "out.normalized" - --- | Where we will write the normalized actual file (for diffing) -testNormalizedActualFileStdout :: TestEnv -> FilePath -testNormalizedActualFileStdout env = testActualFileStdout env <.> "normalized" - --- | Where we will write the normalized expected file (for diffing) -testNormalizedExpectFileStdout :: TestEnv -> FilePath -testNormalizedExpectFileStdout env = testWorkDir env testName env <.> "stdout.normalized" - --- | Where we will write the normalized actual file (for diffing) -testNormalizedActualFileStderr :: TestEnv -> FilePath -testNormalizedActualFileStderr env = testActualFileStderr env <.> "normalized" - --- | Where we will write the normalized expected file (for diffing) -testNormalizedExpectFileStderr :: TestEnv -> FilePath -testNormalizedExpectFileStderr env = testWorkDir env testName env <.> "stderr.normalized" +data Expected = Expect | Actual deriving (Show, Eq, Ord, Enum, Read, Bounded) +data Normalized = Normalized | NotNormalized deriving (Show, Eq, Ord, Enum, Read, Bounded) +data FileDescriptor = Out | Stdout | Stderr deriving (Show, Eq, Ord, Enum, Read, Bounded) + +testFile :: Normalized -> Expected -> FileDescriptor -> TestEnv -> FilePath +testFile n e f = \env -> sourceDir env testName env <.> suffix + where + suffix + = case e of { Expect -> "" ; Actual -> "comp" } + <.> case f of { Out -> "out" ; Stdout -> "stdout" ; Stderr -> "stderr" } + <.> case n of { Normalized -> "normalized" ; NotNormalized -> "" } + sourceDir env = case (e, n) of + (_, Normalized) -> testWorkDir env + (Actual, _) -> testWorkDir env + _ -> testSourceDir env +{-# INLINE testFile #-} + +testActualFile :: FileDescriptor -> TestEnv -> FilePath +testActualFile fd env = testFile NotNormalized Actual fd env +{-# INLINE testActualFile #-} diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index bfd7f0f758b..b7432150090 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -598,7 +598,7 @@ recordHeader args = do initWorkDir liftIO $ putStr str_header liftIO $ C.appendFile (testWorkDir env "test.log") header - liftIO $ C.appendFile (testActualFileOut env) header + liftIO $ C.appendFile (testActualFile Out env) header recordLog :: Result -> TestM () recordLog Result{resultOut, resultStdout, resultStderr, resultCommand} = do @@ -619,9 +619,9 @@ recordLog Result{resultOut, resultStdout, resultStderr, resultCommand} = do RecordAll -> unlines (lines txt) RecordMarked -> getMarkedOutput txt DoNotRecord -> "" - report (testActualFileOut env) resultOut - report (testActualFileStdout env) resultStdout - report (testActualFileStderr env) resultStderr + report (testActualFile Out env) resultOut + report (testActualFile Stdout env) resultStdout + report (testActualFile Stderr env) resultStderr getMarkedOutput :: String -> String -- trailing newline getMarkedOutput out = unlines (go (lines out) False)