sydtest 0.4.0.0 → 0.4.1.0
raw patch · 6 files changed
+92/−46 lines, 6 files
Files
- src/Test/Syd/Def/TestDefM.hs +4/−1
- src/Test/Syd/OptParse.hs +52/−32
- src/Test/Syd/Run.hs +19/−3
- src/Test/Syd/Runner.hs +9/−3
- sydtest.cabal +1/−1
- test/Test/Syd/OptParseSpec.hs +7/−6
src/Test/Syd/Def/TestDefM.hs view
@@ -62,9 +62,12 @@ 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'')
src/Test/Syd/OptParse.hs view
@@ -31,7 +31,7 @@ -- | 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 @@ -- -- 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 @@ -- 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.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,8 +292,16 @@ 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 getFlags = customExecParser prefs_ flagsParser@@ -326,7 +334,7 @@ -- | 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 @@ ] ) )- <*> 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@@ -492,6 +491,27 @@ ) ) <*> 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 =
src/Test/Syd/Run.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -28,6 +29,7 @@ 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 @@ 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 @@ type Test = IO () data TestRunSettings = TestRunSettings- { testRunSettingSeed :: !Int,+ { testRunSettingSeed :: !SeedSetting, testRunSettingMaxSuccess :: !Int, testRunSettingMaxSize :: !Int, testRunSettingMaxDiscardRatio :: !Int,@@ -359,7 +363,7 @@ 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,@@ -367,6 +371,18 @@ testRunSettingGoldenStart = True, 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,
src/Test/Syd/Runner.hs view
@@ -84,9 +84,15 @@ 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.cabal view
@@ -5,7 +5,7 @@ -- 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
test/Test/Syd/OptParseSpec.hs view
@@ -8,12 +8,13 @@ spec :: Spec spec = do describe "combineToSettings" $ do- it "works for this default settinsg example" $ do- let flags = defaultFlags- environment = defaultEnvironment- mConf = Nothing- settings = defaultSettings- combineToSettings flags environment mConf `shouldReturn` settings+ it "works for this default settinsg example" $+ do+ let flags = defaultFlags+ environment = defaultEnvironment+ mConf = Nothing+ settings = defaultSettings+ combineToSettings flags environment mConf `shouldReturn` settings it "works for this debug example" $ do let flags = defaultFlags {flagDebug = Just True}