From 5f806e5a0b086539cfbec416e02f40db7bf42157 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Thu, 9 Nov 2023 06:32:48 -0800 Subject: [PATCH] Refactoring Summary: No functional changes, just nicer Reviewed By: donsbot, malanka Differential Revision: D51122576 fbshipit-source-id: e5f7775222cbaca7c00b1a1c91bc57f591ec1744 --- .../regression/Glean/Regression/Snapshot.hs | 107 +++++++++--------- .../Glean/Regression/Snapshot/Result.hs | 12 +- 2 files changed, 66 insertions(+), 53 deletions(-) diff --git a/glean/test/regression/Glean/Regression/Snapshot.hs b/glean/test/regression/Glean/Regression/Snapshot.hs index da897b3bb..a92475b2f 100644 --- a/glean/test/regression/Glean/Regression/Snapshot.hs +++ b/glean/test/regression/Glean/Regression/Snapshot.hs @@ -34,6 +34,7 @@ import qualified Test.HUnit as HUnit import TestRunner import Util.JSON.Pretty () +import Glean (Backend) import Glean.Indexer import Glean.Init (withUnitTestOptions) import Glean.Regression.Config @@ -66,35 +67,43 @@ runTest -> FilePath -- ^ test root, canonicalized -> TestConfig -> IO [FilePath] -runTest Driver{..} driverOpts root testIn = +runTest driver@Driver{..} driverOpts root testIn = withTestBackend testIn $ \backend -> do let index = indexerRun driverIndexer driverOpts - withTestDatabase backend index Nothing testIn $ - queryMakeOuts testIn backend - where - queryMakeOuts test backend repo = do - queries <- get_queries root mempty (testRoot test) - fmap concat $ forM (Map.elems queries) $ \query -> do - (result, perf) <- runQuery - backend - repo - (defaultTransforms <> driverTransforms) - query - let base = testOutput test dropExtension (takeFileName query) - out = base <.> "out" - perfOut = base <.> "perf" - writeFile out result - mapM_ (writeFile perfOut) perf - return $ if isJust perf then [out,perfOut] else [out] + withTestDatabase backend index Nothing testIn $ \_ -> + runQueries backend driver root testIn - get_queries root qs path = do - files <- listDirectory path - let qs' = Map.union qs $ Map.fromList - [ (file, path file) - | file <- files, ".query" `isExtensionOf` file ] - if equalFilePath path root - then return qs' - else get_queries root qs' $ takeDirectory path +-- | Run the queries +runQueries + :: Backend b + => b + -> Driver opts + -> FilePath -- ^ test root, canonicalized + -> TestConfig + -> IO [FilePath] +runQueries backend Driver{..} root test = do + queries <- get_queries root mempty (testRoot test) + fmap concat $ forM (Map.elems queries) $ \query -> do + (result, perf) <- runQuery + backend + (testRepo test) + (defaultTransforms <> driverTransforms) + query + let base = testOutput test dropExtension (takeFileName query) + out = base <.> "out" + perfOut = base <.> "perf" + writeFile out result + mapM_ (writeFile perfOut) perf + return $ if isJust perf then [out,perfOut] else [out] + where + get_queries root qs path = do + files <- listDirectory path + let qs' = Map.union qs $ Map.fromList + [ (file, path file) + | file <- files, ".query" `isExtensionOf` file ] + if equalFilePath path root + then return qs' + else get_queries root qs' $ takeDirectory path -- | Outputs to compare/regenerate. -- @@ -137,6 +146,20 @@ executeTest cfg driver driverOpts base_group group diff subdir = } createDirectoryIfMissing True $ testOutput test outputs <- runTest driver driverOpts (cfgRoot cfg) test + compareOutputs test diff base_group group outputs + where + with_outdir f = case cfgOutput cfg of + Just dir -> f dir + Nothing -> withSystemTempDirectory "glean-regression" f + +compareOutputs + :: TestConfig + -> (Outputs -> IO Result) -- ^ compare or overwrite golden outputs + -> String + -> String + -> [FilePath] + -> IO Result +compareOutputs test diff base_group group outputs = do fmap mconcat $ forM outputs $ \output -> do let base = testRoot test takeFileName output specific @@ -150,10 +173,6 @@ executeTest cfg driver driverOpts base_group group diff subdir = , outGoldenBase = base , outGoldenGroup = specific } - where - with_outdir f = case cfgOutput cfg of - Just dir -> f dir - Nothing -> withSystemTempDirectory "glean-regression" f -- | Regenerate golden outputs. Do nothing if 'outGoldenBase' exists and is the -- same as 'outGenerated'. Otherwise, copy 'outGenerated' to 'outGoldenGroup' @@ -187,22 +206,6 @@ diff Outputs{..} = do then ": unexpected result\n" ++ sout else ": fatal error\n" ++ serr --- | Wrap 'executeTest' into an 'HUnit.Test' -toHUnit - :: Config - -> Driver opts - -> opts - -> String - -> String - -> FilePath - -> HUnit.Test -toHUnit cfg driver driverOpts base_group group subdir = - HUnit.TestLabel subdir $ HUnit.TestCase $ do - r <- executeTest cfg driver driverOpts base_group group diff subdir - case r of - Success _ -> return () - Failure msg -> HUnit.assertFailure $ unlines $ msg [] - -- | Convert a 'Driver' into a regression test over --root parameter. -- -- Normal mode: find all /testRoot/*/*/ directories and run all tests. @@ -240,11 +243,13 @@ testAll act cfg driver opts = do Success regenerated -> do removeNonRegenerated root test regenerated Nothing -> do - testRunnerAction act $ HUnit.TestList - [ (if null g then id else HUnit.TestLabel g) - $ HUnit.TestList - $ map (toHUnit cfg driver opts (head groups) g) tests - | g <- groups ] + testRunnerAction act $ + HUnit.TestList $ flip map groups $ \g -> + (if null g then id else HUnit.TestLabel g) $ + HUnit.TestList $ flip map tests $ \subdir -> + HUnit.TestLabel subdir $ HUnit.TestCase $ + executeTest cfg driver opts (head groups) g diff subdir + >>= toHUnit where -- clean-up .out or .perf files which weren't regenerated diff --git a/glean/test/regression/Glean/Regression/Snapshot/Result.hs b/glean/test/regression/Glean/Regression/Snapshot/Result.hs index 5ad225886..6c1caecbc 100644 --- a/glean/test/regression/Glean/Regression/Snapshot/Result.hs +++ b/glean/test/regression/Glean/Regression/Snapshot/Result.hs @@ -6,8 +6,11 @@ LICENSE file in the root directory of this source tree. -} -module Glean.Regression.Snapshot.Result (Result(..), failure) -where +module Glean.Regression.Snapshot.Result + ( Result(..), failure, toHUnit + ) where + +import qualified Test.HUnit as HUnit data Result = Success [FilePath] @@ -24,3 +27,8 @@ failure s = Failure (s:) instance Monoid Result where mempty = Success [] + +-- | Use a 'Result' in a 'Test' +toHUnit :: Result -> HUnit.Assertion +toHUnit Success{} = return () +toHUnit (Failure msg) = HUnit.assertFailure $ unlines $ msg []