packages feed

sydtest-sqitch-postgres 0.1.0.0 → 0.1.1.0

raw patch · 5 files changed

+81/−16 lines, 5 filessetup-changed

Files

CHANGELOG.md view
@@ -1,5 +1,14 @@ # Changelog +## [0.1.1.0] - 2026-10-09++### Added++- `withPlanScaledTimeout`, which multiplies the per-test timeout by the+  number of changes in the plan, and `readSqitchPlanSteps` to read them.+  `sqitchPostgresqlSpec` now uses both, so a budget that used to cover+  the whole plan at once covers one change.+ ## [0.1.0.0] - 2026-06-27  ### Changed
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
src/Test/Syd/Sqitch/Postgresql.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -57,6 +58,8 @@ -- @public@. module Test.Syd.Sqitch.Postgresql   ( sqitchPostgresqlSpec,+    readSqitchPlanSteps,+    withPlanScaledTimeout,     runSqitchPerChangeChecks,     runSqitchWholePlanCycle,     module Test.Syd.Sqitch.Postgresql.Plan,@@ -75,6 +78,7 @@ import qualified Database.PostgreSQL.Simple.Options as Postgres import Path import Test.Syd+import Test.Syd.OptParse (Timeout (..)) import Test.Syd.Persistent.Postgresql   ( emptyPostgresOptionsSetupFunc,     postgresqlPoolSetupFunc,@@ -97,16 +101,37 @@   SqitchSettings ->   TestDef outers () sqitchPostgresqlSpec settings =-  describe "sqitch sanity checks" $-    setupAround emptyPostgresOptionsSetupFunc $ do-      perChangeIt settings-      wholePlanCycleIt settings+  describe "sqitch sanity checks" $ do+    steps <- runIO $ readSqitchPlanSteps settings+    withPlanScaledTimeout steps $+      setupAround emptyPostgresOptionsSetupFunc $ do+        perChangeIt settings steps+        wholePlanCycleIt settings -perChangeIt :: SqitchSettings -> TestDef outers Postgres.Options-perChangeIt settings =+-- | Give the tests below one per-test timeout per change in the plan,+-- rather than one for all of them together.+--+-- For tests that shell out to sqitch once or more per change: the work+-- they do grows with the plan, while sydtest's per-test timeout is one+-- fixed wall-clock budget. Left alone, that budget covers less and less+-- of the job as migrations are added, until a loaded machine blows it+-- and the failure names whichever change was in flight rather than+-- anything actually wrong. Scaling keeps the headroom per change+-- constant instead, and keeps honouring whatever the caller configured,+-- including no timeout at all.+--+-- Scales once per application, so wrapping tests that already scale+-- multiplies twice. 'sqitchPostgresqlSpec' applies it to its own.+withPlanScaledTimeout :: [PlanStep] -> TestDef outers inner -> TestDef outers inner+withPlanScaledTimeout steps = modifyTimeout $ \case+  DoNotTimeout -> DoNotTimeout+  TimeoutAfterMicros micros -> TimeoutAfterMicros (micros * max 1 (length steps))++perChangeIt :: SqitchSettings -> [PlanStep] -> TestDef outers Postgres.Options+perChangeIt settings steps =   it "round-trips and (unless grandfathered) is idempotent for every change in sqitch.plan" $     \(opts :: Postgres.Options) ->-      runSqitchPerChangeChecks settings opts+      runPerChangeChecks settings steps opts  wholePlanCycleIt :: SqitchSettings -> TestDef outers Postgres.Options wholePlanCycleIt settings =@@ -118,19 +143,17 @@ -- fresh empty database described by the given options. Exposed in 'IO' -- so callers can wrap it in 'expectFailing' for negative tests. runSqitchPerChangeChecks :: SqitchSettings -> Postgres.Options -> IO ()-runSqitchPerChangeChecks settings opts =+runSqitchPerChangeChecks settings opts = do+  steps <- readSqitchPlanSteps settings+  runPerChangeChecks settings steps opts++runPerChangeChecks :: SqitchSettings -> [PlanStep] -> Postgres.Options -> IO ()+runPerChangeChecks settings steps opts =   unSetupFunc (postgresqlPoolSetupFunc opts) $ \pool ->     -- Deploy into a fresh non-public schema, created and torn down here,     -- so any migration that hardcodes a schema surfaces.     unSetupFunc (randomSchemaSetupFunc pool) $ \schema -> do       let target = sqitchTargetFromOptions schema opts--      planRel <- parseRelFile "sqitch.plan"-      steps <--        readSqitchPlan-          (sqitchSettingsGrandfatherTag settings)-          (sqitchSettingsProjectDir settings </> planRel)-       iterateSteps settings schema target pool steps  -- | Deploy the entire plan, snapshot the schema, revert everything,@@ -204,3 +227,11 @@   Text.decodeUtf8Lenient     <$> SB.readFile       (fromAbsFile (sqitchSettingsProjectDir settings </> deployDir </> fileRel))++-- | The changes in the project's @sqitch.plan@, in plan order.+readSqitchPlanSteps :: SqitchSettings -> IO [PlanStep]+readSqitchPlanSteps settings = do+  planRel <- parseRelFile "sqitch.plan"+  readSqitchPlan+    (sqitchSettingsGrandfatherTag settings)+    (sqitchSettingsProjectDir settings </> planRel)
sydtest-sqitch-postgres.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           sydtest-sqitch-postgres-version:        0.1.0.0+version:        0.1.1.0 synopsis:       A sqitch-on-PostgreSQL companion library for sydtest category:       Testing homepage:       https://github.com/NorfairKing/sydtest#readme
test/Test/Syd/Sqitch/PostgresqlSpec.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -8,6 +10,7 @@ import Path import Path.IO import Test.Syd+import Test.Syd.OptParse (Settings (..), Timeout (..), defaultSettings) import Test.Syd.Persistent.Postgresql (emptyPostgresOptionsSetupFunc) import Test.Syd.Sqitch.Postgresql @@ -33,6 +36,26 @@ spec :: Spec spec = sequential $ do   describe "sqitchPostgresqlSpec" $ do+    -- Both tests do work proportional to the number of changes, so a+    -- fixed budget would shrink as the plan grows.+    it "gives the sqitch tests a timeout that scales with the number of changes" $ do+      settings <- settingsFor [reldir|test_resources/toy-sqitch-ok|] Nothing+      forest <-+        execTestDefM (defaultSettings {settingRandomiseExecutionOrder = False}) $+          sqitchPostgresqlSpec settings+      -- Both tests have to be inside the node, not merely beside it.+      case forest of+        [ DefDescribeNode+            _+            [ DefTimeoutNode+                scaleTimeout+                [DefSpecifyNode _ _ _, DefSpecifyNode _ _ _]+              ]+          ] ->+            map scaleTimeout [DoNotTimeout, TimeoutAfterMicros 1_000_000]+              `shouldBe` [DoNotTimeout, TimeoutAfterMicros 3_000_000]+        _ -> expectationFailure "expected both sqitch tests to sit under a timeout node"+     describe "toy-sqitch-ok" $ do       settings <- runIO $ settingsFor [reldir|test_resources/toy-sqitch-ok|] Nothing       sqitchPostgresqlSpec settings