From 7fe8da587e03245e2c2881de0090bde2cfe2cd3d Mon Sep 17 00:00:00 2001 From: Marcelo Zabani Date: Thu, 29 Feb 2024 11:51:47 -0300 Subject: [PATCH] Separate Check and Run phases of strace test to make sure output is all there (#179) Previously strace's output might not have been fully flushed, and the test would intermittently fail --- Runfile | 6 +- test/SystemResourcesSpecs/OpenFilesSpec.hs | 164 ++++++++++----------- 2 files changed, 86 insertions(+), 84 deletions(-) diff --git a/Runfile b/Runfile index 91e65342..cbd2bf6b 100644 --- a/Runfile +++ b/Runfile @@ -130,7 +130,9 @@ test-system-resources: if [ -n "$NIX" ]; then nix build ".#x86_64-unknown-linux-musl:codd:test:codd-test" -o local/codd-test - nix develop ".#testShells.x86_64-linux.pg16" -i -c run test-with-db-internal --strace --nix -- --match "/SystemResourcesSpecs/" + nix develop ".#testShells.x86_64-linux.pg16" -i -c run test-with-db-internal --strace --nix -- --match "/SystemResourcesSpecs/RUNNING" + nix develop ".#testShells.x86_64-linux.pg16" -i -c run test-with-db-internal --nix -- --match "/SystemResourcesSpecs/CHECKING" else - nix develop ".#testShells.x86_64-linux.pg16" -c run test-with-db-internal --strace -- --match "/SystemResourcesSpecs/" + nix develop ".#testShells.x86_64-linux.pg16" -c run test-with-db-internal --strace -- --match "/SystemResourcesSpecs/RUNNING" + nix develop ".#testShells.x86_64-linux.pg16" -c run test-with-db-internal -- --match "/SystemResourcesSpecs/CHECKING" fi diff --git a/test/SystemResourcesSpecs/OpenFilesSpec.hs b/test/SystemResourcesSpecs/OpenFilesSpec.hs index 795d8023..be30f953 100644 --- a/test/SystemResourcesSpecs/OpenFilesSpec.hs +++ b/test/SystemResourcesSpecs/OpenFilesSpec.hs @@ -5,7 +5,6 @@ import Codd ( VerifySchemas(..) ) import Codd.Environment ( CoddSettings(..) ) import Control.Applicative ( (<|>) ) -import Control.Concurrent ( threadDelay ) import Control.Monad ( foldM , forM_ , void @@ -30,92 +29,93 @@ import UnliftIO ( SomeException spec :: Spec spec = do describe "SystemResourcesSpecs" $ do - describe "Open files limit" $ aroundFreshDatabase $ do - it - "At most one .sql migration file and one on-disk representation file open at a time" - $ \emptyTestDbInfo -> do - void @IO $ runStdoutLoggingT $ applyMigrations - emptyTestDbInfo - { sqlMigrations = - ["test/migrations/open-files-limit/"] - , onDiskReps = Left "./expected-schema" - } - Nothing - testConnTimeout - LaxCheck -- This will output an error but will not throw. What matters is that on-disk reps are read - -- This test must run wrapped in a specific strace incantation as it'll read the output log of that - -- to assert that at most one migration file is opened at a time - -- It seems it's possible for the writes of strace to not have been flushed yet, so wait a second just in case. - threadDelay 1_000_000 - contentsE <- - try $ Text.readFile - "/tmp/strace-codd-system-resources-test.log" - case contentsE of - Left (ex :: SomeException) -> do - putStrLn - "Error reading /tmp/strace-codd-system-resources-test.log. Are you running this with the runfile target or are you running this test directly? This test needs to run under a very specific `strace` command that you'll find in our Runfile test targets, or it doesn't work." - throwM ex - Right contents -> do - let - openAndCloseLines = - filter - (\l -> - -- We test both migrations and on-disk representations - "migrations/open-files-limit" - `Text.isInfixOf` l - || "expected-schema/" - `Text.isInfixOf` l - || "close(" - `Text.isInfixOf` l - ) - $ Text.lines contents - -- forM_ (Text.lines contents) Text.putStrLn - (openFilesAtEnd, atLeastOneMigrationWasOpened) <- - foldM - (\(openFiles, atLeastOneMig) line -> do - case P.parseOnly openParser line of - Right (fp, fd) -> - if Map.size openFiles > 0 - then do - putStrLn - "More than one simultaneously open migration or on-disk representation! Here's the strace log:" - forM_ - openAndCloseLines - Text.putStrLn + aroundFreshDatabase + $ it + "RUNNING - At most one .sql migration file and one on-disk representation file open at a time" + $ \emptyTestDbInfo -> do + void @IO $ runStdoutLoggingT $ applyMigrations + emptyTestDbInfo + { sqlMigrations = + ["test/migrations/open-files-limit/"] + , onDiskReps = Left "./expected-schema" + } + Nothing + testConnTimeout + LaxCheck -- This will output an error but will not throw. What matters is that on-disk reps are read + -- This test must run wrapped in a specific strace incantation as it'll read the output log of that + -- to assert that at most one migration file is opened at a time + + it + "CHECKING - At most one .sql migration file and one on-disk representation file open at a time" + $ do + contentsE <- + try $ Text.readFile + "/tmp/strace-codd-system-resources-test.log" + case contentsE of + Left (ex :: SomeException) -> do + putStrLn + "Error reading /tmp/strace-codd-system-resources-test.log. Are you running this with the runfile target or are you running this test directly? This test needs to run after a very specific `strace` wrapped command that you'll find in our Runfile test targets, or it doesn't work." + throwM ex + Right contents -> do + let openAndCloseLines = + filter + (\l -> + -- We test both migrations and on-disk representations + "migrations/open-files-limit" + `Text.isInfixOf` l + || "expected-schema/" + `Text.isInfixOf` l + || "close(" + `Text.isInfixOf` l + ) + $ Text.lines contents + -- forM_ (Text.lines contents) Text.putStrLn + (openFilesAtEnd, atLeastOneMigrationWasOpened) <- + foldM + (\(openFiles, atLeastOneMig) line -> do + case P.parseOnly openParser line of + Right (fp, fd) -> + if Map.size openFiles > 0 + then do + putStrLn + "More than one simultaneously open migration or on-disk representation! Here's the strace log:" + forM_ + openAndCloseLines + Text.putStrLn + error + "More than one file open simultaneously. Test failed." + else do + pure + ( Map.insert + fd + fp + openFiles + , True + ) + Left _ -> do + case + P.parseOnly + closeParser + line + of + Left e -> error - "More than one file open simultaneously. Test failed." - else do + $ "Found strace line that could not be parsed due to '" + ++ show e + ++ "': " + ++ show line + Right fd -> pure - ( Map.insert + ( Map.delete fd - fp openFiles - , True + , atLeastOneMig ) - Left _ -> do - case - P.parseOnly - closeParser - line - of - Left e -> - error - $ "Found strace line that could not be parsed due to '" - ++ show e - ++ "': " - ++ show line - Right fd -> - pure - ( Map.delete - fd - openFiles - , atLeastOneMig - ) - ) - (Map.empty :: Map.Map Int FilePath, False) - openAndCloseLines - openFilesAtEnd `shouldBe` Map.empty - atLeastOneMigrationWasOpened `shouldBe` True -- Otherwise we might be stracing different processes. This is a good sanity check. + ) + (Map.empty :: Map.Map Int FilePath, False) + openAndCloseLines + openFilesAtEnd `shouldBe` Map.empty + atLeastOneMigrationWasOpened `shouldBe` True -- Otherwise we might be stracing different processes. This is a good sanity check. -- | Parses both glibc's `openat` and musl's `open` syscalls from a `strace -f -o` output line and returns the opened file and file descriptor. openParser :: P.Parser (FilePath, Int)