Merge pull request #640 from IntersectMBO/mgalazyn/fix/fix-flaky-para…

…llel-testnet-data-stdout Fix parallel `create-testnet-data` stdout contents test
IntersectMBO · Mar 8, 2024 · 3329895 · 3329895
2 parents d2449e0 + f3d9e94
commit 3329895
Show file tree

Hide file tree

Showing 3 changed files with 57 additions and 35 deletions.
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,8 +6,6 @@ import           Cardano.Api.Shelley (ShelleyGenesis (..))
 
 import qualified Cardano.Ledger.Shelley.API as L
 
-import           Control.Concurrent (newQSem)
-import           Control.Concurrent.QSem (QSem)
 import           Control.Monad
 import           Control.Monad.IO.Class
 import qualified Data.Aeson as Aeson
@@ -18,9 +16,8 @@ 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 (bracketSem, execCardanoCLI)
+import           Test.Cardano.CLI.Util (FileSem, bracketSem, execCardanoCLI, newFileSem)
 
 import           Hedgehog (Property)
 import qualified Hedgehog as H
@@ -81,9 +78,8 @@ 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
+createTestnetDataOutSem :: FileSem
+createTestnetDataOutSem = newFileSem "test/cardano-cli-golden/files/golden/conway/create-testnet-data.out"
 {-# NOINLINE createTestnetDataOutSem  #-}
 
 -- | This test tests the non-transient case, i.e. it maximizes the files
@@ -112,7 +108,7 @@ golden_create_testnet_data mShelleyTemplate =
     void $ H.note generated''
 
     bracketSem createTestnetDataOutSem $
-      H.diffVsGoldenFile generated'' "test/cardano-cli-golden/files/golden/conway/create-testnet-data.out"
+      H.diffVsGoldenFile generated''
 
     bs <- liftIO $ LBS.readFile $ outputDir </> "genesis.json"
     genesis :: ShelleyGenesis StandardCrypto <- Aeson.throwDecode bs

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,10 +7,7 @@ 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 ((.&.))
@@ -19,7 +16,7 @@ import           Numeric (showOct)
 import           System.Posix.Files (fileMode, getFileStatus)
 #endif
 
-import           Test.Cardano.CLI.Util (execCardanoCLI, noteInputFile, noteTempFile, propertyOnce, bracketSem)
+import           Test.Cardano.CLI.Util (FileSem, bracketSem, execCardanoCLI, noteInputFile, noteTempFile, propertyOnce, newFileSem)
 
 import           Hedgehog
 import qualified Hedgehog as H
@@ -28,15 +25,13 @@ 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
+drepRetirementCertSem :: FileSem
+drepRetirementCertSem = newFileSem "test/cardano-cli-golden/files/golden/governance/drep/drep_retirement_cert"
 {-# 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
+drepRegistrationCertSem :: FileSem
+drepRegistrationCertSem = newFileSem "test/cardano-cli-golden/files/golden/governance/drep/drep_registration_certificate.json"
 {-# NOINLINE drepRegistrationCertSem #-}
 
 hprop_golden_governanceDRepKeyGen :: Property
@@ -124,7 +119,7 @@ hprop_golden_governance_drep_retirement_certificate_vkey_file =
   propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
     drepVKeyFile <- noteInputFile "test/cardano-cli-golden/files/input/drep.vkey"
     certFile <- H.noteTempFile tempDir "drep.retirement.cert"
-    goldenDRepRetirementCertFile <- H.note "test/cardano-cli-golden/files/golden/governance/drep/drep_retirement_cert"
+    H.noteShow_ drepRetirementCertSem
 
     void $ execCardanoCLI
       [  "conway", "governance", "drep", "retirement-certificate"
@@ -134,13 +129,13 @@ hprop_golden_governance_drep_retirement_certificate_vkey_file =
       ]
 
     bracketSem drepRetirementCertSem $
-      H.diffFileVsGoldenFile certFile goldenDRepRetirementCertFile
+      H.diffFileVsGoldenFile certFile
 
 hprop_golden_governance_drep_retirement_certificate_id_hex :: Property
 hprop_golden_governance_drep_retirement_certificate_id_hex =
   propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
     certFile <- H.noteTempFile tempDir "drep.retirement.cert"
-    goldenDRepRetirementCertFile <- H.note "test/cardano-cli-golden/files/golden/governance/drep/drep_retirement_cert"
+    H.noteShow_ drepRetirementCertSem
 
     idFile <- H.readFile "test/cardano-cli-golden/files/input/drep.id.hex"
 
@@ -152,13 +147,13 @@ hprop_golden_governance_drep_retirement_certificate_id_hex =
       ]
 
     bracketSem drepRetirementCertSem $
-      H.diffFileVsGoldenFile certFile goldenDRepRetirementCertFile
+      H.diffFileVsGoldenFile certFile
 
 hprop_golden_governance_drep_retirement_certificate_id_bech32 :: Property
 hprop_golden_governance_drep_retirement_certificate_id_bech32 =
   propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
     certFile <- H.noteTempFile tempDir "drep.retirement.cert"
-    goldenDRepRetirementCertFile <- H.note "test/cardano-cli-golden/files/golden/governance/drep/drep_retirement_cert"
+    H.noteShow_ drepRetirementCertSem
 
     idFile <- H.readFile "test/cardano-cli-golden/files/input/drep.id.bech32"
 
@@ -170,7 +165,7 @@ hprop_golden_governance_drep_retirement_certificate_id_bech32 =
       ]
 
     bracketSem drepRetirementCertSem $
-      H.diffFileVsGoldenFile certFile goldenDRepRetirementCertFile
+      H.diffFileVsGoldenFile certFile
 
 hprop_golden_governance_drep_metadata_hash :: Property
 hprop_golden_governance_drep_metadata_hash = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
@@ -192,7 +187,7 @@ hprop_golden_governance_drep_metadata_hash = propertyOnce . H.moduleWorkspace "t
 hprop_golden_governance_drep_registration_certificate_vkey_file :: Property
 hprop_golden_governance_drep_registration_certificate_vkey_file = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
   drepVKeyFile <- noteInputFile "test/cardano-cli-golden/files/input/drep.vkey"
-  goldenFile <- H.note "test/cardano-cli-golden/files/golden/governance/drep/drep_registration_certificate.json"
+  H.noteShow_ drepRegistrationCertSem
 
   outFile <- H.noteTempFile tempDir "drep-reg-cert.txt"
 
@@ -206,12 +201,12 @@ hprop_golden_governance_drep_registration_certificate_vkey_file = propertyOnce .
     ]
 
   bracketSem drepRegistrationCertSem $
-    H.diffFileVsGoldenFile outFile goldenFile
+    H.diffFileVsGoldenFile outFile
 
 hprop_golden_governance_drep_registration_certificate_id_hex :: Property
 hprop_golden_governance_drep_registration_certificate_id_hex = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
   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"
+  H.noteShow_ drepRegistrationCertSem
 
   outFile <- H.noteTempFile tempDir "drep-reg-cert.txt"
 
@@ -225,12 +220,12 @@ hprop_golden_governance_drep_registration_certificate_id_hex = propertyOnce . H.
     ]
 
   bracketSem drepRegistrationCertSem $
-    H.diffFileVsGoldenFile outFile goldenFile
+    H.diffFileVsGoldenFile outFile
 
 hprop_golden_governance_drep_registration_certificate_id_bech32 :: Property
 hprop_golden_governance_drep_registration_certificate_id_bech32 = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
   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"
+  H.noteShow_ drepRegistrationCertSem
 
   outFile <- H.noteTempFile tempDir "drep-reg-cert.txt"
 
@@ -244,7 +239,7 @@ hprop_golden_governance_drep_registration_certificate_id_bech32 = propertyOnce .
     ]
 
   bracketSem drepRegistrationCertSem $
-    H.diffFileVsGoldenFile outFile goldenFile
+    H.diffFileVsGoldenFile outFile
 
 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,5 +1,8 @@
+{-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE StandaloneDeriving #-}
 
 module Test.Cardano.CLI.Util
   ( checkTxCddlFormat
@@ -15,13 +18,15 @@ module Test.Cardano.CLI.Util
 
   , redactJsonField
   , bracketSem
+  , FileSem
+  , newFileSem
   ) where
 
 import           Cardano.Api
 
 import           Cardano.CLI.Read
 
-import           Control.Concurrent (QSem, signalQSem, waitQSem)
+import           Control.Concurrent (QSem, newQSem, signalQSem, waitQSem)
 import           Control.Exception.Lifted (bracket_)
 import           Control.Monad.Base
 import           Control.Monad.Catch hiding (bracket_)
@@ -42,6 +47,7 @@ import qualified System.Environment as IO
 import qualified System.Exit as IO
 import           System.FilePath (takeDirectory)
 import qualified System.IO.Unsafe as IO
+import           System.IO.Unsafe (unsafePerformIO)
 import qualified System.Process as IO
 import           System.Process (CreateProcess)
 
@@ -284,7 +290,32 @@ redactJsonField fieldName replacement sourceFilePath targetFilePath = GHC.withFr
         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)
+
+-- | A file semaphore protecting against a concurrent path access
+data FileSem = FileSem !FilePath !QSem
+
+instance Show FileSem where
+  show (FileSem path _) = "FileSem " ++ path
+
+deriving via (ShowOf FileSem) instance Pretty FileSem
+
+-- | Create new file semaphore. Always use with @NOINLINE@ pragma! Example:
+-- @
+-- createTestnetDataOutSem :: FileSem
+-- createTestnetDataOutSem = newFileSem "test/cardano-cli-golden/files/golden/conway/create-testnet-data.out"
+-- {-# NOINLINE createTestnetDataOutSem  #-}
+-- @
+newFileSem :: FilePath -- ^ path to be guarded by a semaphore allowing only one concurrent to access it
+           -> FileSem
+newFileSem fp = unsafePerformIO $ FileSem fp <$> newQSem 1
+{-# INLINE newFileSem #-}
+
+-- | Run action acquiring a semaphore, and releasing afterwards. Guards against concurrent access to
+-- a block of code.
+bracketSem :: MonadBaseControl IO m
+           => FileSem -- ^ a file semaphore
+           -> (FilePath -> m c) -- ^ an action, a file path will be extracted from the semaphore
+           -> m c
+bracketSem (FileSem path semaphore) act =
+  bracket_ (liftBase $ waitQSem semaphore) (liftBase $ signalQSem semaphore) $
+    act path