Simplify test{,Normalized}{Actual,Expect}File{Out,Stdout,Stderr} fami…

…ly of functions
haskell · Nov 29, 2021 · 3b1d3c5 · 3b1d3c5
1 parent 061d603
commit 3b1d3c5
Show file tree

Hide file tree

Showing 3 changed files with 47 additions and 100 deletions.
diff --git 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
@@ -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
@@ -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)