Skip to content
This repository was archived by the owner on Aug 18, 2020. It is now read-only.

Commit 54a1394

Browse files
author
Michael Hueschen
committed
[CO-354] Run testsuites with multiple ProtocolMagics
To minimize risk of inadequate test coverage, due to too few `ProtocolMagic`s being used, we run the tests a specified number of times, with different `ProtocolMagic` values. We also use `choose` from Quickcheck to get uniformly distributed random values for the `ProtocolMagicId` field. `arbitrary`, by comparison, generates small Int32s, which is not desirable for testing because we want to exercise multiple sizes of CBOR encoding.
1 parent d900522 commit 54a1394

File tree

36 files changed

+513
-215
lines changed

36 files changed

+513
-215
lines changed

‎client/test/Test/Pos/Client/Txp/UtilSpec.hs

+14-5
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@ import qualified Data.Map as M
1515
import qualified Data.Set as S
1616
import Formatting (build, hex, left, sformat, shown, (%), (%.))
1717
import Test.Hspec (Spec, describe, runIO)
18-
import Test.Hspec.QuickCheck (prop)
18+
import Test.Hspec.QuickCheck (modifyMaxSuccess, prop)
1919
import Test.QuickCheck (Discard (..), Gen, Testable, arbitrary, choose, generate)
2020
import Test.QuickCheck.Monadic (forAllM, stop)
2121

@@ -38,23 +38,32 @@ import Pos.Util.Util (leftToPanic)
3838
import Test.Pos.Client.Txp.Mode (HasTxpConfigurations, TxpTestMode, TxpTestProperty,
3939
withBVData)
4040
import Test.Pos.Configuration (withProvidedMagicConfig)
41+
import Test.Pos.Crypto.Arbitrary (genProtocolMagicUniformWithRNM)
4142
import Test.Pos.Util.QuickCheck.Arbitrary (nonrepeating)
4243
import Test.Pos.Util.QuickCheck.Property (stopProperty)
4344

4445
----------------------------------------------------------------------------
4546
-- Tests
4647
----------------------------------------------------------------------------
4748

49+
50+
-- We run the tests this number of times, with different `ProtocolMagics`, to get increased
51+
-- coverage. We should really do this inside of the `prop`, but it is difficult to do that
52+
-- without significant rewriting of the testsuite.
53+
testMultiple :: Int
54+
testMultiple = 3
55+
4856
spec :: Spec
4957
spec = do
5058
runWithMagic NMMustBeNothing
5159
runWithMagic NMMustBeJust
5260

5361
runWithMagic :: RequiresNetworkMagic -> Spec
54-
runWithMagic rnm = do
55-
pm <- (\ident -> ProtocolMagic ident rnm) <$> runIO (generate arbitrary)
56-
describe ("(requiresNetworkMagic=" ++ show rnm ++ ")") $
57-
specBody pm
62+
runWithMagic rnm = replicateM_ testMultiple $
63+
modifyMaxSuccess (`div` testMultiple) $ do
64+
pm <- runIO (generate (genProtocolMagicUniformWithRNM rnm))
65+
describe ("(requiresNetworkMagic=" ++ show rnm ++ ")") $
66+
specBody pm
5867

5968
specBody :: ProtocolMagic -> Spec
6069
specBody pm = withProvidedMagicConfig pm $

‎core/test/Test/Pos/Core/AddressSpec.hs

+13-4
Original file line numberDiff line numberDiff line change
@@ -27,17 +27,26 @@ import Pos.Crypto (EncryptedSecretKey, PassPhrase, ProtocolMagic (..),
2727
import Pos.Crypto.HD (HDAddressPayload (..))
2828

2929
import Test.Pos.Core.Arbitrary ()
30+
import Test.Pos.Crypto.Arbitrary (genProtocolMagicUniformWithRNM)
31+
32+
33+
-- We run the tests this number of times, with different `ProtocolMagics`, to get increased
34+
-- coverage. We should really do this inside of the `prop`, but it is difficult to do that
35+
-- without significant rewriting of the testsuite.
36+
testMultiple :: Int
37+
testMultiple = 3
3038

3139
spec :: Spec
3240
spec = do
3341
runWithMagic NMMustBeNothing
3442
runWithMagic NMMustBeJust
3543

3644
runWithMagic :: RequiresNetworkMagic -> Spec
37-
runWithMagic rnm = do
38-
pm <- (\ident -> ProtocolMagic ident rnm) <$> runIO (generate arbitrary)
39-
describe ("(requiresNetworkMagic=" ++ show rnm ++ ")") $
40-
specBody pm
45+
runWithMagic rnm = replicateM_ testMultiple $
46+
modifyMaxSuccess (`div` testMultiple) $ do
47+
pm <- runIO (generate (genProtocolMagicUniformWithRNM rnm))
48+
describe ("(requiresNetworkMagic=" ++ show rnm ++ ")") $
49+
specBody pm
4150

4251
-- An attempt to avoid rightward creep
4352
specBody :: ProtocolMagic -> Spec

‎core/test/Test/Pos/Core/CborSpec.hs

+48-41
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,7 @@ module Test.Pos.Core.CborSpec
1313
import Universum
1414

1515
import Test.Hspec (Spec, describe, runIO)
16+
import Test.Hspec.QuickCheck (modifyMaxSuccess)
1617
import Test.QuickCheck (Arbitrary (..), generate)
1718
import Test.QuickCheck.Arbitrary.Generic (genericArbitrary, genericShrink)
1819

@@ -29,7 +30,7 @@ import Pos.Merkle (MerkleTree)
2930
import Test.Pos.Binary.Helpers (binaryTest)
3031
import Test.Pos.Core.Arbitrary ()
3132
import Test.Pos.Core.Chrono ()
32-
import Test.Pos.Crypto.Arbitrary ()
33+
import Test.Pos.Crypto.Arbitrary (genProtocolMagicUniformWithRNM)
3334

3435

3536
data MyScript = MyScript
@@ -77,50 +78,56 @@ instance Bi (Attributes X2) where
7778

7879
----------------------------------------
7980

81+
-- We run the tests this number of times, with different `ProtocolMagics`, to get increased
82+
-- coverage. We should really do this inside of the `prop`, but it is difficult to do that
83+
-- without significant rewriting of the testsuite.
84+
testMultiple :: Int
85+
testMultiple = 3
8086

8187
spec :: Spec
8288
spec = do
8389
runWithMagic NMMustBeNothing
8490
runWithMagic NMMustBeJust
8591

8692
runWithMagic :: RequiresNetworkMagic -> Spec
87-
runWithMagic rnm = do
88-
pm <- (\ident -> ProtocolMagic ident rnm) <$> runIO (generate arbitrary)
89-
describe ("(requiresNetworkMagic=" ++ show rnm ++ ")") $
90-
withGenesisSpec 0 (defaultCoreConfiguration pm) $ \_ ->
91-
describe "Cbor Bi instances" $ do
92-
describe "Core.Address" $ do
93-
binaryTest @Address
94-
binaryTest @Address'
95-
binaryTest @AddrType
96-
binaryTest @AddrStakeDistribution
97-
binaryTest @AddrSpendingData
98-
describe "Core.Types" $ do
99-
binaryTest @Timestamp
100-
binaryTest @TimeDiff
101-
binaryTest @EpochIndex
102-
binaryTest @Coin
103-
binaryTest @CoinPortion
104-
binaryTest @LocalSlotIndex
105-
binaryTest @SlotId
106-
binaryTest @EpochOrSlot
107-
binaryTest @SharedSeed
108-
binaryTest @ChainDifficulty
109-
binaryTest @SoftforkRule
110-
binaryTest @BlockVersionData
111-
binaryTest @(Attributes ())
112-
binaryTest @(Attributes AddrAttributes)
113-
describe "Core.Fee" $ do
114-
binaryTest @Coeff
115-
binaryTest @TxSizeLinear
116-
binaryTest @TxFeePolicy
117-
describe "Core.Script" $ do
118-
binaryTest @Script
119-
describe "Core.Vss" $ do
120-
binaryTest @VssCertificate
121-
describe "Core.Version" $ do
122-
binaryTest @ApplicationName
123-
binaryTest @SoftwareVersion
124-
binaryTest @BlockVersion
125-
describe "Merkle" $ do
126-
binaryTest @(MerkleTree Int32)
93+
runWithMagic rnm = replicateM_ testMultiple $
94+
modifyMaxSuccess (`div` testMultiple) $ do
95+
pm <- runIO (generate (genProtocolMagicUniformWithRNM rnm))
96+
describe ("(requiresNetworkMagic=" ++ show rnm ++ ")") $
97+
withGenesisSpec 0 (defaultCoreConfiguration pm) $ \_ ->
98+
describe "Cbor Bi instances" $ do
99+
describe "Core.Address" $ do
100+
binaryTest @Address
101+
binaryTest @Address'
102+
binaryTest @AddrType
103+
binaryTest @AddrStakeDistribution
104+
binaryTest @AddrSpendingData
105+
describe "Core.Types" $ do
106+
binaryTest @Timestamp
107+
binaryTest @TimeDiff
108+
binaryTest @EpochIndex
109+
binaryTest @Coin
110+
binaryTest @CoinPortion
111+
binaryTest @LocalSlotIndex
112+
binaryTest @SlotId
113+
binaryTest @EpochOrSlot
114+
binaryTest @SharedSeed
115+
binaryTest @ChainDifficulty
116+
binaryTest @SoftforkRule
117+
binaryTest @BlockVersionData
118+
binaryTest @(Attributes ())
119+
binaryTest @(Attributes AddrAttributes)
120+
describe "Core.Fee" $ do
121+
binaryTest @Coeff
122+
binaryTest @TxSizeLinear
123+
binaryTest @TxFeePolicy
124+
describe "Core.Script" $ do
125+
binaryTest @Script
126+
describe "Core.Vss" $ do
127+
binaryTest @VssCertificate
128+
describe "Core.Version" $ do
129+
binaryTest @ApplicationName
130+
binaryTest @SoftwareVersion
131+
binaryTest @BlockVersion
132+
describe "Merkle" $ do
133+
binaryTest @(MerkleTree Int32)

‎core/test/Test/Pos/Core/SlottingSpec.hs

+15-7
Original file line numberDiff line numberDiff line change
@@ -7,27 +7,35 @@ module Test.Pos.Core.SlottingSpec
77
import Universum
88

99
import Test.Hspec (Expectation, Spec, anyErrorCall, describe, runIO)
10-
import Test.Hspec.QuickCheck (prop)
11-
import Test.QuickCheck (NonNegative (..), Positive (..), Property, arbitrary, generate,
12-
(===), (==>))
10+
import Test.Hspec.QuickCheck (modifyMaxSuccess, prop)
11+
import Test.QuickCheck (NonNegative (..), Positive (..), Property, generate, (===), (==>))
1312

1413
import Pos.Core (EpochOrSlot, HasConfiguration, SlotId (..), defaultCoreConfiguration,
1514
flattenSlotId, unflattenSlotId, withGenesisSpec)
1615
import Pos.Crypto (ProtocolMagic (..), RequiresNetworkMagic (..))
1716

1817
import Test.Pos.Core.Arbitrary (EoSToIntOverflow (..), UnreasonableEoS (..))
18+
import Test.Pos.Crypto.Arbitrary (genProtocolMagicUniformWithRNM)
1919
import Test.Pos.Util.QuickCheck.Property (shouldThrowException, (.=.))
2020

21+
22+
-- We run the tests this number of times, with different `ProtocolMagics`, to get increased
23+
-- coverage. We should really do this inside of the `prop`, but it is difficult to do that
24+
-- without significant rewriting of the testsuite.
25+
testMultiple :: Int
26+
testMultiple = 3
27+
2128
spec :: Spec
2229
spec = do
2330
runWithMagic NMMustBeNothing
2431
runWithMagic NMMustBeJust
2532

2633
runWithMagic :: RequiresNetworkMagic -> Spec
27-
runWithMagic rnm = do
28-
pm <- (\ident -> ProtocolMagic ident rnm) <$> runIO (generate arbitrary)
29-
describe ("(requiresNetworkMagic=" ++ show rnm ++ ")") $
30-
specBody pm
34+
runWithMagic rnm = replicateM_ testMultiple $
35+
modifyMaxSuccess (`div` testMultiple) $ do
36+
pm <- runIO (generate (genProtocolMagicUniformWithRNM rnm))
37+
describe ("(requiresNetworkMagic=" ++ show rnm ++ ")") $
38+
specBody pm
3139

3240
specBody :: ProtocolMagic -> Spec
3341
specBody pm = withGenesisSpec 0 (defaultCoreConfiguration pm) $ \_ -> describe "Slotting" $ do

‎crypto/test/Test/Pos/Crypto/Arbitrary.hs

+8-1
Original file line numberDiff line numberDiff line change
@@ -9,14 +9,15 @@ module Test.Pos.Crypto.Arbitrary
99
, genSignature
1010
, genSignatureEncoded
1111
, genRedeemSignature
12+
, genProtocolMagicUniformWithRNM
1213
) where
1314

1415
import Universum hiding (keys)
1516

1617
import Control.Monad (zipWithM)
1718
import qualified Data.ByteArray as ByteArray
1819
import Data.List.NonEmpty (fromList)
19-
import Test.QuickCheck (Arbitrary (..), Gen, elements, oneof, vector)
20+
import Test.QuickCheck (Arbitrary (..), Gen, choose, elements, oneof, vector)
2021
import Test.QuickCheck.Arbitrary.Generic (genericArbitrary, genericShrink)
2122

2223
import Pos.Binary.Class (AsBinary (..), AsBinaryClass (..), Bi, Raw)
@@ -54,6 +55,12 @@ instance Arbitrary ProtocolMagicId where
5455
instance Arbitrary RequiresNetworkMagic where
5556
arbitrary = elements [NMMustBeNothing, NMMustBeJust]
5657

58+
genProtocolMagicUniformWithRNM :: RequiresNetworkMagic -> Gen ProtocolMagic
59+
genProtocolMagicUniformWithRNM rnm =
60+
(\ident -> ProtocolMagic (ProtocolMagicId ident) rnm)
61+
<$>
62+
choose (minBound, maxBound)
63+
5764
{- A note on 'Arbitrary' instances
5865
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
5966

‎explorer/cardano-sl-explorer.cabal

+1
Original file line numberDiff line numberDiff line change
@@ -356,6 +356,7 @@ test-suite cardano-explorer-test
356356
, cardano-sl-block-test
357357
, cardano-sl-core
358358
, cardano-sl-crypto
359+
, cardano-sl-crypto-test
359360
, cardano-sl-explorer
360361
, cardano-sl-txp
361362
, cardano-sl-util

‎explorer/test/Test/Pos/Explorer/Socket/MethodsSpec.hs

+14-6
Original file line numberDiff line numberDiff line change
@@ -16,12 +16,12 @@ import qualified Data.Set as S
1616
import Network.EngineIO (SocketId)
1717

1818
import Test.Hspec (Spec, anyException, describe, it, runIO, shouldBe, shouldThrow)
19-
import Test.Hspec.QuickCheck (modifyMaxSize, prop)
19+
import Test.Hspec.QuickCheck (modifyMaxSize, modifyMaxSuccess, prop)
2020
import Test.QuickCheck (Property, arbitrary, forAll, generate)
2121
import Test.QuickCheck.Monadic (assert, monadicIO, run)
2222

2323
import Pos.Core.NetworkMagic (NetworkMagic, makeNetworkMagic)
24-
import Pos.Crypto (ProtocolMagic (..), RequiresNetworkMagic (..), SecretKey)
24+
import Pos.Crypto (RequiresNetworkMagic (..), SecretKey)
2525
import Pos.Explorer.ExplorerMode (runSubTestMode)
2626
import Pos.Explorer.Socket.Holder (ConnectionsState, ExplorerSocket (..),
2727
csAddressSubscribers, csBlocksPageSubscribers,
@@ -36,6 +36,7 @@ import Pos.Explorer.Socket.Methods (addrSubParam, addressSetByTxs, blo
3636
import Pos.Explorer.TestUtil (secretKeyToAddress)
3737
import Pos.Explorer.Web.ClientTypes (CAddress (..), toCAddress)
3838

39+
import Test.Pos.Crypto.Arbitrary (genProtocolMagicUniformWithRNM)
3940
import Test.Pos.Explorer.MockFactory (mkTxOut)
4041

4142

@@ -45,16 +46,23 @@ import Test.Pos.Explorer.MockFactory (mkTxOut)
4546

4647
-- stack test cardano-sl-explorer --fast --test-arguments "-m Test.Pos.Explorer.Socket"
4748

49+
-- We run the tests this number of times, with different `ProtocolMagics`, to get increased
50+
-- coverage. We should really do this inside of the `prop`, but it is difficult to do that
51+
-- without significant rewriting of the testsuite.
52+
testMultiple :: Int
53+
testMultiple = 3
54+
4855
spec :: Spec
4956
spec = do
5057
runWithMagic NMMustBeNothing
5158
runWithMagic NMMustBeJust
5259

5360
runWithMagic :: RequiresNetworkMagic -> Spec
54-
runWithMagic rnm = do
55-
pm <- (\ident -> ProtocolMagic ident rnm) <$> runIO (generate arbitrary)
56-
describe ("(requiresNetworkMagic=" ++ show rnm ++ ")") $
57-
specBody (makeNetworkMagic pm)
61+
runWithMagic rnm = replicateM_ testMultiple $
62+
modifyMaxSuccess (`div` testMultiple) $ do
63+
pm <- runIO (generate (genProtocolMagicUniformWithRNM rnm))
64+
describe ("(requiresNetworkMagic=" ++ show rnm ++ ")") $
65+
specBody (makeNetworkMagic pm)
5866

5967
specBody :: NetworkMagic -> Spec
6068
specBody nm =

‎explorer/test/Test/Pos/Explorer/Web/ServerSpec.hs

+13-4
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,7 @@ import Pos.Util.Mockable ()
3131

3232
import Test.Pos.Block.Arbitrary ()
3333
import Test.Pos.Configuration (withProvidedMagicConfig)
34+
import Test.Pos.Crypto.Arbitrary (genProtocolMagicUniformWithRNM)
3435

3536

3637
----------------------------------------------------------------
@@ -40,16 +41,24 @@ import Test.Pos.Configuration (withProvidedMagicConfig)
4041
{-# ANN module ("HLint: ignore Reduce duplication" :: Text) #-}
4142

4243
-- stack test cardano-sl-explorer --fast --test-arguments "-m Pos.Explorer.Web.Server"
44+
45+
-- We run the tests this number of times, with different `ProtocolMagics`, to get increased
46+
-- coverage. We should really do this inside of the `prop`, but it is difficult to do that
47+
-- without significant rewriting of the testsuite.
48+
testMultiple :: Int
49+
testMultiple = 3
50+
4351
spec :: Spec
4452
spec = do
4553
runWithMagic NMMustBeNothing
4654
runWithMagic NMMustBeJust
4755

4856
runWithMagic :: RequiresNetworkMagic -> Spec
49-
runWithMagic rnm = do
50-
pm <- (\ident -> ProtocolMagic ident rnm) <$> runIO (generate arbitrary)
51-
describe ("(requiresNetworkMagic=" ++ show rnm ++ ")") $
52-
specBody pm
57+
runWithMagic rnm = replicateM_ testMultiple $
58+
modifyMaxSuccess (`div` testMultiple) $ do
59+
pm <- runIO (generate (genProtocolMagicUniformWithRNM rnm))
60+
describe ("(requiresNetworkMagic=" ++ show rnm ++ ")") $
61+
specBody pm
5362

5463
specBody :: ProtocolMagic -> Spec
5564
specBody pm = withProvidedMagicConfig pm $ do

0 commit comments

Comments
 (0)