Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Enable parallel execution of tests #637

Merged
merged 1 commit into from
Mar 8, 2024
Merged

Enable parallel execution of tests #637

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 5 additions & 2 deletions cardano-cli/cardano-cli.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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"
21 changes: 15 additions & 6 deletions cardano-cli/test/cardano-cli-golden/Test/Golden/CreateTestnetData.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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 :: ()
Expand All @@ -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"
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

If this test is run once, how does concurrent execution cause it to run multiple times?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It's executed once. The problem is that this golden file is shared between multiple test cases, which are executed concurrently. So when we're testing golden files regeneration, two test cases see the file missing so they try to recreate file at the same time. This somehow is an issue on windows, which results in an exception here.


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
Expand Down
41 changes: 31 additions & 10 deletions cardano-cli/test/cardano-cli-golden/Test/Golden/Governance/DRep.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 ((.&.))
Expand All @@ -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
Expand Down Expand Up @@ -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"
Expand All @@ -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 =
Expand All @@ -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 =
Expand All @@ -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
Expand Down Expand Up @@ -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"

Expand All @@ -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"

Expand All @@ -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
Expand Down
14 changes: 13 additions & 1 deletion cardano-cli/test/cardano-cli-test-lib/Test/Cardano/CLI/Util.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,6 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}

module Test.Cardano.CLI.Util
( checkTxCddlFormat
, checkTextEnvelopeFormat
Expand All @@ -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
Expand Down Expand Up @@ -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)
Loading