tmp-postgres 1.14.0.0 → 1.14.0.1

raw patch · 5 files changed

+113/−3 lines, 5 filesdep ~basedep ~postgres-optionsdep ~processnew-component:exe:soak-test

Dependency ranges changed: base, postgres-options, process

Files

• resource-soak-test/Main.hs +69/−0
• src/Database/Postgres/Temp/Internal/Config.hs +2/−0
• src/Database/Postgres/Temp/Internal/Core.hs +2/−1
• test/Main.hs +6/−1
• tmp-postgres.cabal +34/−1

@@ -0,0 +1,69 @@+module Main where++import Control.Exception+import Control.Concurrent+import Database.Postgres.Temp+import Control.Concurrent.Async+import qualified Database.PostgreSQL.Simple as PG+import System.Exit+import System.IO.Temp+import System.Process+import Control.Monad (unless, forM_, forever, void)+import System.Directory+++withConn :: DB -> (PG.Connection -> IO a) -> IO a+withConn db = bracket (PG.connectPostgreSQL $ toConnectionString db ) PG.close++countPostgresProcesses :: IO Int+countPostgresProcesses = do+  -- TODO we should restrict to child process+  (exitCode, xs, _) <-  readProcessWithExitCode "pgrep" ["postgres"] []++  unless (exitCode == ExitSuccess || exitCode == ExitFailure 1) $ throwIO exitCode++  pure $ length $ lines xs++main :: IO ()+main = withTempDirectory "/tmp" "tmp-postgres-spec" $ \directoryPath ->+  forM_ [0, 10 .. 1000000] $ \theDelay -> do+    let theConfig = defaultConfig+          { temporaryDirectory = pure directoryPath+          , plan = (plan defaultConfig)+              { logger = pure print+              }+          }++    initialContents <- listDirectory directoryPath+    initialCount <- countPostgresProcesses++    thread <- async $ withConfig theConfig $ flip withConn $ \conn -> forever $ do+      (_one :: Int) <- fmap (PG.fromOnly . head) $ PG.query_ conn "SELECT 1"+      threadDelay 1000++    threadDelay theDelay+    throwTo (asyncThreadId thread) $ userError "stop already"++    void $ waitCatch thread++    finalContents <- listDirectory directoryPath+    finalCount <- countPostgresProcesses++    unless (initialCount == finalCount) $+      throwIO $ userError $ unlines+        [ "failed to clean up postgres"+        , "had"+        , show initialCount+        , "initially and now have"+        , show finalCount+        ]++    unless (initialContents == finalContents) $ do+      renameDirectory directoryPath $ directoryPath <> "_failed"+      throwIO $ userError $ unlines+        [ "failed to clean up files"+        , "had"+        , unlines initialContents+        , "initially and now have"+        , unlines finalContents+        ]

@@ -327,6 +327,8 @@   let ignoreDirIsMissing e         | isDoesNotExistError e = return ()         | otherwise = throwIO e+  -- I'm trying to prevent new files getting added+  -- to the dir as I am deleting the files.   removeDirectoryRecursive mainDir `catch` ignoreDirIsMissing  -- | Either remove a 'CTemporary' directory or do nothing to a 'CPermanent'

@@ -170,7 +170,8 @@   -> CompleteProcessConfig   -- ^ Process config   -> IO ExitCode-executeProcess name = startProcess name >=> waitForProcess+executeProcess name conf =+  bracket (startProcess name conf) terminateProcess waitForProcess  -- | Start a process and block until it finishes return the 'ExitCode' and the --   stderr output.

@@ -3,6 +3,7 @@ import           Control.Monad ((<=<), void, unless) import           Data.Function import qualified Data.Map.Strict as Map+import           Data.Maybe import           Data.Monoid import           Data.Monoid.Generic import qualified Data.Set as Set@@ -59,10 +60,14 @@   countPostgresProcesses `shouldReturn` initialPostgresCount  testSuccessfulConfig :: ConfigAndAssertion -> IO ()-testSuccessfulConfig configAssert = do+testSuccessfulConfig configAssert@ConfigAndAssertion{..} = do   -- get the temp listing before+  let tmpDir = fromMaybe (error "test is bad")+        $ getLast $ temporaryDirectory cConfig+  initialContents <- listDirectory tmpDir   testSuccessfulConfigNoTmp configAssert   -- get the temp listing after+  listDirectory tmpDir `shouldReturn` initialContents  testWithTemporaryDirectory :: ConfigAndAssertion -> (ConfigAndAssertion -> IO a) -> IO a testWithTemporaryDirectory x f =

@@ -1,5 +1,5 @@ name:                tmp-postgres-version:             1.14.0.0+version:             1.14.0.1 synopsis: Start and stop a temporary postgres description: Start and stop a temporary postgres. See README.md homepage:            https://github.com/jfischoff/tmp-postgres#readme@@ -98,6 +98,39 @@     , criterion     , postgres-options     , postgresql-simple+    , tmp-postgres+  default-extensions:+      ApplicativeDo+    , DeriveFunctor+    , DeriveGeneric+    , DerivingStrategies+    , DerivingVia+    , GeneralizedNewtypeDeriving+    , LambdaCase+    , OverloadedStrings+    , RankNTypes+    , RecordWildCards+    , ScopedTypeVariables+    , TemplateHaskell+    , TupleSections+    , ViewPatterns++source-repository head+  type:     git+  location: https://github.com/jfischoff/tmp-postgres++executable soak-test+  main-is: Main.hs+  hs-source-dirs: resource-soak-test+  default-language: Haskell2010+  ghc-options: -O2 -Wall+  build-depends: base+    , async+    , directory+    , postgres-options+    , postgresql-simple+    , process+    , temporary     , tmp-postgres   default-extensions:       ApplicativeDo