Enable parallel execution of tests. Add semaphore

for golden files overwritten in multiple tests.
IntersectMBO · Mar 8, 2024 · d0440d4 · d0440d4
1 parent df5c712
commit d0440d4
Show file tree

Hide file tree

Showing 4 changed files with 64 additions and 19 deletions.
diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal
@@ -268,8 +268,11 @@ library cardano-cli-test-lib
                       , filepath
                       , hedgehog
                       , hedgehog-extras ^>= 0.6.1.0
+                      , lifted-base
+                      , monad-control
                       , process
                       , text
+                      , transformers-base
 
 test-suite cardano-cli-test
   import:               project-config
@@ -313,7 +316,7 @@ test-suite cardano-cli-test
                         Test.Cli.Pipes
                         Test.Cli.Shelley.Run.Query
 
-  ghc-options:          -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-T
+  ghc-options:          -threaded -rtsopts "-with-rtsopts=-N -T"
 
 test-suite cardano-cli-golden
   import:               project-config
@@ -420,4 +423,4 @@ test-suite cardano-cli-golden
                         Test.Golden.TxView
                         Test.Golden.Version
 
-  ghc-options:          -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-T
+  ghc-options:          -threaded -rtsopts "-with-rtsopts=-N -T"
diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/CreateTestnetData.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/CreateTestnetData.hs
@@ -6,7 +6,9 @@ import           Cardano.Api.Shelley (ShelleyGenesis (..))
 
 import qualified Cardano.Ledger.Shelley.API as L
 
-import           Control.Monad (filterM, forM_, void)
+import           Control.Concurrent (newQSem)
+import           Control.Concurrent.QSem (QSem)
+import           Control.Monad
 import           Control.Monad.IO.Class
 import qualified Data.Aeson as Aeson
 import qualified Data.ByteString.Lazy as LBS
@@ -16,16 +18,16 @@ import           Data.Word (Word32)
 import           System.Directory
 import           System.Directory.Extra (listDirectories)
 import           System.FilePath
+import           System.IO.Unsafe (unsafePerformIO)
 
-import           Test.Cardano.CLI.Util (execCardanoCLI)
+import           Test.Cardano.CLI.Util (bracketSem, execCardanoCLI)
 
 import           Hedgehog (Property)
 import qualified Hedgehog as H
 import           Hedgehog.Extras (moduleWorkspace, propertyOnce)
 import qualified Hedgehog.Extras as H
 import qualified Hedgehog.Extras.Test.Golden as H
 
-{- HLINT ignore "Move brackets to avoid $" -}
 {- HLINT ignore "Use camelCase" -}
 
 networkMagic :: Word32
@@ -78,6 +80,12 @@ hprop_golden_create_testnet_data_with_template :: Property
 hprop_golden_create_testnet_data_with_template =
   golden_create_testnet_data $ Just "test/cardano-cli-golden/files/input/shelley/genesis/genesis.spec.json"
 
+-- | Semaphore protecting against locked file error, when running properties concurrently.
+-- This semaphore protects @"test/cardano-cli-golden/files/golden/conway/create-testnet-data.out"@.
+createTestnetDataOutSem :: QSem
+createTestnetDataOutSem = unsafePerformIO $ newQSem 1
+{-# NOINLINE createTestnetDataOutSem  #-}
+
 -- | This test tests the non-transient case, i.e. it maximizes the files
 -- that can be written to disk.
 golden_create_testnet_data :: ()
@@ -103,16 +111,17 @@ golden_create_testnet_data mShelleyTemplate =
         generated'' = map (\c -> if c == '\\' then '/' else c) generated'
     void $ H.note generated''
 
-    H.diffVsGoldenFile generated'' "test/cardano-cli-golden/files/golden/conway/create-testnet-data.out"
+    bracketSem createTestnetDataOutSem $
+      H.diffVsGoldenFile generated'' "test/cardano-cli-golden/files/golden/conway/create-testnet-data.out"
 
     bs <- liftIO $ LBS.readFile $ outputDir </> "genesis.json"
     genesis :: ShelleyGenesis StandardCrypto <- Aeson.throwDecode bs
 
     sgNetworkMagic genesis H.=== networkMagic
-    (length $ L.sgsPools $ sgStaking genesis) H.=== numPools
+    length (L.sgsPools $ sgStaking genesis) H.=== numPools
 
     forM_ (L.sgsPools $ sgStaking genesis) $ \pool ->
-      (Seq.length $ L.ppRelays pool) H.=== 1
+      Seq.length (L.ppRelays pool) H.=== 1
 
     actualNumDReps <- liftIO $ listDirectories $ outputDir </> "drep-keys"
     length actualNumDReps H.=== numDReps

diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/DRep.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/DRep.hs
@@ -7,7 +7,10 @@ module Test.Golden.Governance.DRep where
 #define UNIX
 #endif
 
+import           Control.Concurrent (newQSem)
+import           Control.Concurrent.QSem (QSem)
 import           Control.Monad
+import           System.IO.Unsafe (unsafePerformIO)
 
 #ifdef UNIX
 import           Data.Bits ((.&.))
@@ -16,14 +19,26 @@ import           Numeric (showOct)
 import           System.Posix.Files (fileMode, getFileStatus)
 #endif
 
-import           Test.Cardano.CLI.Util (execCardanoCLI, noteInputFile, noteTempFile, propertyOnce)
+import           Test.Cardano.CLI.Util (execCardanoCLI, noteInputFile, noteTempFile, propertyOnce, bracketSem)
 
 import           Hedgehog
 import qualified Hedgehog as H
 import qualified Hedgehog.Extras.Test.Base as H
 import qualified Hedgehog.Extras.Test.File as H
 import qualified Hedgehog.Extras.Test.Golden as H
 
+-- | Semaphore protecting against locked file error, when running properties concurrently.
+-- This semaphore protects @"test/cardano-cli-golden/files/golden/governance/drep/drep_retirement_cert"@.
+drepRetirementCertSem :: QSem
+drepRetirementCertSem = unsafePerformIO $ newQSem 1
+{-# NOINLINE drepRetirementCertSem #-}
+
+-- | Semaphore protecting against locked file error, when running properties concurrently.
+-- This semaphore protects @"test/cardano-cli-golden/files/golden/governance/drep/drep_registration_certificate.json"@.
+drepRegistrationCertSem :: QSem
+drepRegistrationCertSem = unsafePerformIO $ newQSem 1
+{-# NOINLINE drepRegistrationCertSem #-}
+
 hprop_golden_governanceDRepKeyGen :: Property
 hprop_golden_governanceDRepKeyGen =
   propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
@@ -92,8 +107,8 @@ hprop_golden_governance_drep_extended_key_signing =
     skeyFile <- noteInputFile "test/cardano-cli-golden/files/input/governance/drep/extended-key-signing/drep.skey"
     txBody <- noteInputFile "test/cardano-cli-golden/files/input/governance/drep/extended-key-signing/tx.body"
 
-    outGold <- H.note "test/cardano-cli-golden/files/golden/governance/drep/extended-key-signing/tx.signed"
     outFile <- H.noteTempFile tempDir "outFile"
+    outGold <- H.note "test/cardano-cli-golden/files/golden/governance/drep/extended-key-signing/tx.signed"
 
     void $ execCardanoCLI
       [  "conway", "transaction", "sign"
@@ -118,7 +133,8 @@ hprop_golden_governance_drep_retirement_certificate_vkey_file =
       , "--out-file", certFile
       ]
 
-    H.diffFileVsGoldenFile certFile goldenDRepRetirementCertFile
+    bracketSem drepRetirementCertSem $
+      H.diffFileVsGoldenFile certFile goldenDRepRetirementCertFile
 
 hprop_golden_governance_drep_retirement_certificate_id_hex :: Property
 hprop_golden_governance_drep_retirement_certificate_id_hex =
@@ -135,7 +151,8 @@ hprop_golden_governance_drep_retirement_certificate_id_hex =
       , "--out-file", certFile
       ]
 
-    H.diffFileVsGoldenFile certFile goldenDRepRetirementCertFile
+    bracketSem drepRetirementCertSem $
+      H.diffFileVsGoldenFile certFile goldenDRepRetirementCertFile
 
 hprop_golden_governance_drep_retirement_certificate_id_bech32 :: Property
 hprop_golden_governance_drep_retirement_certificate_id_bech32 =
@@ -152,7 +169,8 @@ hprop_golden_governance_drep_retirement_certificate_id_bech32 =
       , "--out-file", certFile
       ]
 
-    H.diffFileVsGoldenFile certFile goldenDRepRetirementCertFile
+    bracketSem drepRetirementCertSem $
+      H.diffFileVsGoldenFile certFile goldenDRepRetirementCertFile
 
 hprop_golden_governance_drep_metadata_hash :: Property
 hprop_golden_governance_drep_metadata_hash = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
@@ -187,12 +205,13 @@ hprop_golden_governance_drep_registration_certificate_vkey_file = propertyOnce .
     , "--out-file", outFile
     ]
 
-  H.diffFileVsGoldenFile outFile goldenFile
+  bracketSem drepRegistrationCertSem $
+    H.diffFileVsGoldenFile outFile goldenFile
 
 hprop_golden_governance_drep_registration_certificate_id_hex :: Property
 hprop_golden_governance_drep_registration_certificate_id_hex = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
-  goldenFile <- H.note "test/cardano-cli-golden/files/golden/governance/drep/drep_registration_certificate.json"
   idFile <- H.readFile "test/cardano-cli-golden/files/input/drep.id.hex"
+  goldenFile <- H.note "test/cardano-cli-golden/files/golden/governance/drep/drep_registration_certificate.json"
 
   outFile <- H.noteTempFile tempDir "drep-reg-cert.txt"
 
@@ -205,12 +224,13 @@ hprop_golden_governance_drep_registration_certificate_id_hex = propertyOnce . H.
     , "--out-file", outFile
     ]
 
-  H.diffFileVsGoldenFile outFile goldenFile
+  bracketSem drepRegistrationCertSem $
+    H.diffFileVsGoldenFile outFile goldenFile
 
 hprop_golden_governance_drep_registration_certificate_id_bech32 :: Property
 hprop_golden_governance_drep_registration_certificate_id_bech32 = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
-  goldenFile <- H.note "test/cardano-cli-golden/files/golden/governance/drep/drep_registration_certificate.json"
   idFile <- H.readFile "test/cardano-cli-golden/files/input/drep.id.bech32"
+  goldenFile <- H.note "test/cardano-cli-golden/files/golden/governance/drep/drep_registration_certificate.json"
 
   outFile <- H.noteTempFile tempDir "drep-reg-cert.txt"
 
@@ -223,7 +243,8 @@ hprop_golden_governance_drep_registration_certificate_id_bech32 = propertyOnce .
     , "--out-file", outFile
     ]
 
-  H.diffFileVsGoldenFile outFile goldenFile
+  bracketSem drepRegistrationCertSem $
+    H.diffFileVsGoldenFile outFile goldenFile
 
 hprop_golden_governance_drep_registration_certificate_script_hash :: Property
 hprop_golden_governance_drep_registration_certificate_script_hash = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do

diff --git a/cardano-cli/test/cardano-cli-test-lib/Test/Cardano/CLI/Util.hs b/cardano-cli/test/cardano-cli-test-lib/Test/Cardano/CLI/Util.hs
@@ -1,4 +1,6 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
+
 module Test.Cardano.CLI.Util
   ( checkTxCddlFormat
   , checkTextEnvelopeFormat
@@ -12,13 +14,18 @@ module Test.Cardano.CLI.Util
   , noteTempFile
 
   , redactJsonField
+  , bracketSem
   ) where
 
 import           Cardano.Api
 
 import           Cardano.CLI.Read
 
-import           Control.Monad.Catch
+import           Control.Concurrent (QSem, signalQSem, waitQSem)
+import           Control.Exception.Lifted (bracket_)
+import           Control.Monad.Base
+import           Control.Monad.Catch hiding (bracket_)
+import           Control.Monad.Trans.Control (MonadBaseControl)
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Encode.Pretty as Aeson
 import qualified Data.Aeson.Key as Aeson
@@ -276,3 +283,8 @@ redactJsonField fieldName replacement sourceFilePath targetFilePath = GHC.withFr
               else v
         v -> pure v
       H.evalIO $ LBS.writeFile targetFilePath (Aeson.encodePretty redactedJson)
+
+-- | Run action acquiring a semaphore, and releasing afterwards. Allows to guard against concurrent access to
+-- a block of code
+bracketSem :: MonadBaseControl IO m => QSem -> m c -> m c
+bracketSem semaphore = bracket_ (liftBase $ waitQSem semaphore) (liftBase $ signalQSem semaphore)