make it possible to use random seeds

sydtest/CHANGELOG.md

@@ -1,5 +1,11 @@
 # Changelog
 
+## [0.4.1.0] - 2021-10-10
+
+### Added
+
+* The `--random-seed` option to use random seeds instead of the fixed seed that is used by default.
+
 ## [0.4.0.0] - 2021-09-02
 
 ### Added

sydtest/package.yaml

@@ -1,5 +1,5 @@
 name: sydtest
-version: 0.4.0.0
+version: 0.4.1.0
 github: "NorfairKing/sydtest"
 license: OtherLicense
 license-file: LICENSE.md

sydtest/src/Test/Syd/Def/TestDefM.hs

@@ -62,9 +62,12 @@ runTestDefM sets defFunc = do
   let func = unTestDefM defFunc
   (a, _, testForest) <- runRWST func (toTestRunSettings sets) ()
   let testForest' = filterTestForest (settingFilter sets) testForest
+  stdgen <- case settingSeed sets of
+    FixedSeed seed -> pure $ mkStdGen seed
+    RandomSeed -> newStdGen
   let testForest'' =
         if settingRandomiseExecutionOrder sets
-          then evalRand (randomiseTestForest testForest') (mkStdGen (settingSeed sets))
+          then evalRand (randomiseTestForest testForest') stdgen
           else testForest'
   pure (a, testForest'')
 

sydtest/src/Test/Syd/OptParse.hs

@@ -31,7 +31,7 @@ getSettings = do
 -- | Test suite definition and run settings
 data Settings = Settings
   { -- | The seed to use for deterministic randomness
-    settingSeed :: !Int,
+    settingSeed :: !SeedSetting,
     -- | Randomise the execution order of the tests in the test suite
     settingRandomiseExecutionOrder :: !Bool,
     -- | How parallel to run the test suite
@@ -139,7 +139,7 @@ combineToSettings Flags {..} Environment {..} mConf = do
 --
 -- Use 'YamlParse.readConfigFile' or 'YamlParse.readFirstConfigFile' to read a configuration.
 data Configuration = Configuration
-  { configSeed :: !(Maybe Int),
+  { configSeed :: !(Maybe SeedSetting),
     configRandomiseExecutionOrder :: !(Maybe Bool),
     configThreads :: !(Maybe Threads),
     configMaxSize :: !(Maybe Int),
@@ -220,7 +220,7 @@ defaultConfigFile = resolveFile' ".sydtest.yaml"
 -- For example, use 'Text', not 'SqliteConfig'.
 data Environment = Environment
   { envConfigFile :: Maybe FilePath,
-    envSeed :: !(Maybe Int),
+    envSeed :: !(Maybe SeedSetting),
     envRandomiseExecutionOrder :: !(Maybe Bool),
     envThreads :: !(Maybe Threads),
     envMaxSize :: !(Maybe Int),
@@ -265,25 +265,25 @@ environmentParser :: Env.Parser Env.Error Environment
 environmentParser =
   Env.prefixed "SYDTEST_" $
     Environment
-      <$> Env.var (fmap Just . Env.str) "CONFIG_FILE" (mE <> Env.help "Config file")
-        <*> Env.var (fmap Just . Env.auto) "SEED" (mE <> Env.help "Seed for random generation of test cases")
-        <*> ( Env.var (fmap Just . Env.auto) "RANDOMISE_EXECUTION_ORDER" (mE <> Env.help "Randomise the execution order of the tests in the test suite")
-                <|> Env.var (fmap Just . Env.auto) "RANDOMIZE_EXECUTION_ORDER" (mE <> Env.help "Randomize the execution order of the tests in the test suite")
+      <$> Env.var (fmap Just . Env.str) "CONFIG_FILE" (Env.def Nothing <> Env.help "Config file")
+        <*> seedSettingEnvironmentParser
+        <*> ( Env.var (fmap Just . Env.auto) "RANDOMISE_EXECUTION_ORDER" (Env.def Nothing <> Env.help "Randomise the execution order of the tests in the test suite")
+                <|> Env.var (fmap Just . Env.auto) "RANDOMIZE_EXECUTION_ORDER" (Env.def Nothing <> Env.help "Randomize the execution order of the tests in the test suite")
             )
-        <*> Env.var (fmap Just . (Env.auto >=> parseThreads)) "PARALLELISM" (mE <> Env.help "How parallel to execute the tests")
-        <*> Env.var (fmap Just . Env.auto) "MAX_SUCCESS" (mE <> Env.help "Number of quickcheck examples to run")
-        <*> Env.var (fmap Just . Env.auto) "MAX_SIZE" (mE <> Env.help "Maximum size parameter to pass to generators")
-        <*> Env.var (fmap Just . Env.auto) "MAX_DISCARD" (mE <> Env.help "Maximum number of discarded tests per successful test before giving up")
-        <*> Env.var (fmap Just . Env.auto) "MAX_SHRINKS" (mE <> Env.help "Maximum number of shrinks of a failing test input")
-        <*> Env.var (fmap Just . Env.auto) "GOLDEN_START" (mE <> Env.help "Whether to write golden tests if they do not exist yet")
-        <*> Env.var (fmap Just . Env.auto) "GOLDEN_RESET" (mE <> Env.help "Whether to overwrite golden tests instead of having them fail")
-        <*> ( Env.var (fmap Just . Env.auto) "COLOUR" (mE <> Env.help "Whether to use coloured output")
-                <|> Env.var (fmap Just . Env.auto) "COLOR" (mE <> Env.help "Whether to use colored output")
+        <*> Env.var (fmap Just . (Env.auto >=> parseThreads)) "PARALLELISM" (Env.def Nothing <> Env.help "How parallel to execute the tests")
+        <*> Env.var (fmap Just . Env.auto) "MAX_SUCCESS" (Env.def Nothing <> Env.help "Number of quickcheck examples to run")
+        <*> Env.var (fmap Just . Env.auto) "MAX_SIZE" (Env.def Nothing <> Env.help "Maximum size parameter to pass to generators")
+        <*> Env.var (fmap Just . Env.auto) "MAX_DISCARD" (Env.def Nothing <> Env.help "Maximum number of discarded tests per successful test before giving up")
+        <*> Env.var (fmap Just . Env.auto) "MAX_SHRINKS" (Env.def Nothing <> Env.help "Maximum number of shrinks of a failing test input")
+        <*> Env.var (fmap Just . Env.auto) "GOLDEN_START" (Env.def Nothing <> Env.help "Whether to write golden tests if they do not exist yet")
+        <*> Env.var (fmap Just . Env.auto) "GOLDEN_RESET" (Env.def Nothing <> Env.help "Whether to overwrite golden tests instead of having them fail")
+        <*> ( Env.var (fmap Just . Env.auto) "COLOUR" (Env.def Nothing <> Env.help "Whether to use coloured output")
+                <|> Env.var (fmap Just . Env.auto) "COLOR" (Env.def Nothing <> Env.help "Whether to use colored output")
             )
-        <*> Env.var (fmap Just . Env.str) "FILTER" (mE <> Env.help "Filter to select which parts of the test tree to run")
-        <*> Env.var (fmap Just . Env.auto) "FAIL_FAST" (mE <> Env.help "Whether to stop executing upon the first test failure")
-        <*> Env.var (fmap Just . (Env.auto >=> parseIterations)) "ITERATIONS" (mE <> Env.help "How many iterations to use to look diagnose flakiness")
-        <*> Env.var (fmap Just . Env.auto) "DEBUG" (mE <> Env.help "Turn on debug mode. This implies RANDOMISE_EXECUTION_ORDER=False, PARALLELISM=1 and FAIL_FAST=True.")
+        <*> Env.var (fmap Just . Env.str) "FILTER" (Env.def Nothing <> Env.help "Filter to select which parts of the test tree to run")
+        <*> Env.var (fmap Just . Env.auto) "FAIL_FAST" (Env.def Nothing <> Env.help "Whether to stop executing upon the first test failure")
+        <*> Env.var (fmap Just . (Env.auto >=> parseIterations)) "ITERATIONS" (Env.def Nothing <> Env.help "How many iterations to use to look diagnose flakiness")
+        <*> Env.var (fmap Just . Env.auto) "DEBUG" (Env.def Nothing <> Env.help "Turn on debug mode. This implies RANDOMISE_EXECUTION_ORDER=False, PARALLELISM=1 and FAIL_FAST=True.")
   where
     parseThreads :: Int -> Either e Threads
     parseThreads 1 = Right Synchronous
@@ -292,7 +292,15 @@ environmentParser =
     parseIterations 0 = Right Continuous
     parseIterations 1 = Right OneIteration
     parseIterations i = Right (Iterations i)
-    mE = Env.def Nothing
+
+seedSettingEnvironmentParser :: Env.Parser Env.Error (Maybe SeedSetting)
+seedSettingEnvironmentParser =
+  combine
+    <$> Env.var (fmap Just . Env.auto) "SEED" (Env.def Nothing <> Env.help "Seed for random generation of test cases")
+    <*> Env.switch "RANDOM_SEED" (Env.help "Use a random seed for every test case")
+  where
+    combine :: Maybe Int -> Bool -> Maybe SeedSetting
+    combine mSeed random = if random then Just RandomSeed else FixedSeed <$> mSeed
 
 -- | Get the command-line flags
 getFlags :: IO Flags
@@ -326,7 +334,7 @@ flagsParser =
 -- | The flags that are common across commands.
 data Flags = Flags
   { flagConfigFile :: !(Maybe FilePath),
-    flagSeed :: !(Maybe Int),
+    flagSeed :: !(Maybe SeedSetting),
     flagRandomiseExecutionOrder :: !(Maybe Bool),
     flagThreads :: !(Maybe Threads),
     flagMaxSuccess :: !(Maybe Int),
@@ -376,16 +384,7 @@ parseFlags =
               ]
           )
       )
-    <*> optional
-      ( option
-          auto
-          ( mconcat
-              [ long "seed",
-                help "Seed for random generation of test cases",
-                metavar "SEED"
-              ]
-          )
-      )
+    <*> seedSettingFlags
     <*> doubleSwitch ["randomise-execution-order", "randomize-execution-order"] (help "Randomise the execution order of the tests in the test suite")
     <*> optional
       ( ( ( \case
@@ -493,6 +492,27 @@ parseFlags =
       )
     <*> doubleSwitch ["debug"] (help "Turn on debug mode. This implies --no-randomise-execution-order, --synchronous and --fail-fast.")
 
+seedSettingFlags :: OptParse.Parser (Maybe SeedSetting)
+seedSettingFlags =
+  optional $
+    ( FixedSeed
+        <$> option
+          auto
+          ( mconcat
+              [ long "seed",
+                help "Seed for random generation of test cases",
+                metavar "SEED"
+              ]
+          )
+    )
+      <|> flag'
+        RandomSeed
+        ( mconcat
+            [ long "random-seed",
+              help "Use a random seed instead of a fixed seed"
+            ]
+        )
+
 doubleSwitch :: [String] -> OptParse.Mod FlagFields (Maybe Bool) -> OptParse.Parser (Maybe Bool)
 doubleSwitch suffixes mods =
   flag' (Just True) (hidden <> internal <> foldMap long suffixes <> mods)

sydtest/src/Test/Syd/Run.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -28,6 +29,7 @@ import Test.QuickCheck.Property hiding (Result (..))
 import qualified Test.QuickCheck.Property as QCP
 import Test.QuickCheck.Random
 import Text.Printf
+import YamlParse.Applicative
 
 class IsTest e where
   -- | The argument from 'aroundAll'
@@ -162,7 +164,9 @@ instance IsTest (outerArgs -> innerArg -> Property) where
 makeQuickCheckArgs :: TestRunSettings -> Args
 makeQuickCheckArgs TestRunSettings {..} =
   stdArgs
-    { replay = Just (mkQCGen testRunSettingSeed, 0),
+    { replay = case testRunSettingSeed of
+        RandomSeed -> Nothing
+        FixedSeed s -> Just (mkQCGen s, 0),
       chatty = False,
       maxSuccess = testRunSettingMaxSuccess,
       maxDiscardRatio = testRunSettingMaxDiscardRatio,
@@ -346,7 +350,7 @@ exceptionHandlers =
 type Test = IO ()
 
 data TestRunSettings = TestRunSettings
-  { testRunSettingSeed :: !Int,
+  { testRunSettingSeed :: !SeedSetting,
     testRunSettingMaxSuccess :: !Int,
     testRunSettingMaxSize :: !Int,
     testRunSettingMaxDiscardRatio :: !Int,
@@ -359,7 +363,7 @@ data TestRunSettings = TestRunSettings
 defaultTestRunSettings :: TestRunSettings
 defaultTestRunSettings =
   TestRunSettings
-    { testRunSettingSeed = 42, -- This is set by default because we want reproducability by default.
+    { testRunSettingSeed = FixedSeed 42, -- This is set by default because we want reproducability by default.
       testRunSettingMaxSuccess = maxSuccess stdArgs,
       testRunSettingMaxSize = maxSize stdArgs,
       testRunSettingMaxDiscardRatio = maxDiscardRatio stdArgs,
@@ -368,6 +372,18 @@ defaultTestRunSettings =
       testRunSettingGoldenReset = False
     }
 
+data SeedSetting
+  = RandomSeed
+  | FixedSeed !Int
+  deriving (Show, Eq, Generic)
+
+instance YamlSchema SeedSetting where
+  yamlSchema =
+    alternatives
+      [ RandomSeed <$ literalString "random",
+        FixedSeed <$> yamlSchema
+      ]
+
 data TestRunResult = TestRunResult
   { testRunResultStatus :: !TestStatus,
     testRunResultException :: !(Maybe (Either String Assertion)),

sydtest/src/Test/Syd/Runner.hs

@@ -84,9 +84,15 @@ sydTestIterations totalIterations sets spec =
           pure r
 
     let go iteration = do
-          let newSeed = settingSeed sets + iteration
-          putStrLn $ printf "Running iteration: %4d with seed %4d" iteration newSeed
-          rf <- runOnce $ sets {settingSeed = newSeed}
+          newSeedSetting <- case settingSeed sets of
+            FixedSeed seed -> do
+              let newSeed = seed + iteration
+              putStrLn $ printf "Running iteration: %4d with seed %4d" iteration newSeed
+              pure $ FixedSeed newSeed
+            RandomSeed -> do
+              putStrLn $ printf "Running iteration: %4d with random seeds" iteration
+              pure RandomSeed
+          rf <- runOnce $ sets {settingSeed = newSeedSetting}
           if shouldExitFail (timedValue rf)
             then pure rf
             else case totalIterations of

sydtest/sydtest.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           sydtest
-version:        0.4.0.0
+version:        0.4.1.0
 synopsis:       A modern testing framework for Haskell with good defaults and advanced testing features.
 description:    A modern testing framework for Haskell with good defaults and advanced testing features. Sydtest aims to make the common easy and the hard possible. See https://github.com/NorfairKing/sydtest#readme for more information.
 category:       Testing

sydtest/test_resources/defaultSettings-show.golden

@@ -1,5 +1,5 @@
 Settings
-  { settingSeed = 42
+  { settingSeed = FixedSeed 42
   , settingRandomiseExecutionOrder = True
   , settingThreads = ByCapabilities
   , settingMaxSuccess = 100