diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,11 @@ # Changelog +## [0.9.0.0] - 2022-04-13 + +### Added + +* Optional type-safe progress reporting for property tests. + ## [0.8.0.1] - 2022-02-11 ### Changed diff --git a/LICENSE.md b/LICENSE.md --- a/LICENSE.md +++ b/LICENSE.md @@ -1,37 +1,49 @@ -Sydtest License +# Sydtest License Copyright (c) 2020-2022 Tom Sydney Kerckhove +## Anyone + **Anyone** can use this software to test your software under the following license: -Permissions: +### Permissions: + * The licensed software may be distributed. * The licensed software may be modified. * The licensed software may be used to test the software under test. -Conditions: +### Conditions: + * _The software under test is not used for commercial purposes._ + **OR** + _The software under test is open-source software licensed according to an [OSI-approved Open Source license](https://opensource.org/licenses)._ * Any modifications to the licensed software must be made public under the same license with the same copyright holder. * The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. -Limitations: +### Limitations: + * The software is provided "as is", without warranty of any kind, express or implied, including but not limited to the warranties of merchantability, fitness for a particular purpose and noninfringement. * In no event shall the authors or copyright holders be liable for any claim, damages or other liability, whether in an action of contract, tort or otherwise, arising from, out of or in connection with the software or the use or other dealings in the software. - +## Contributors and Sponsors **Contributors listed in [CONTRIBUTORS](./CONTRIBUTORS) or [GitHub sponsors of NorfairKing](https://github.com/sponsors/NorfairKing)** can use this software to test their software under the following conditions: -Permissions: Any +### Permissions -Conditions: +Any + +### Conditions + * The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. -Limitations: +### Limitations + * The software is provided "as is", without warranty of any kind, express or implied, including but not limited to the warranties of merchantability, fitness for a particular purpose and noninfringement. * In no event shall the authors or copyright holders be liable for any claim, damages or other liability, whether in an action of contract, tort or otherwise, arising from, out of or in connection with the software or the use or other dealings in the software. +## Other arrangements **You can [contact me](https://cs-syd.eu/contact) for other arrangements (like a permanent license) on a case-to-case basis.** diff --git a/src/Test/Syd/Def/Around.hs b/src/Test/Syd/Def/Around.hs --- a/src/Test/Syd/Def/Around.hs +++ b/src/Test/Syd/Def/Around.hs @@ -186,10 +186,11 @@ let modifyVal :: forall x. HContains x outer => - (((HList x -> newInner -> IO ()) -> IO ()) -> IO TestRunResult) -> + (ProgressReporter -> ((HList x -> newInner -> IO ()) -> IO ()) -> IO TestRunResult) -> + ProgressReporter -> ((HList x -> oldInner -> IO ()) -> IO ()) -> IO TestRunResult - modifyVal takeSupplyXC supplyXD = + modifyVal takeSupplyXC progressReporter supplyXD = let supplyXC :: (HList x -> newInner -> IO ()) -> IO () supplyXC takeXC = let takeXD :: HList x -> oldInner -> IO () @@ -197,7 +198,7 @@ let takeAC _ c = takeXC x c in func takeAC (getElem x) d in supplyXD takeXD - in takeSupplyXC supplyXC + in takeSupplyXC progressReporter supplyXC -- For this function to work recursively, the first parameter of the input and the output types must be the same modifyTree :: diff --git a/src/Test/Syd/Def/Specify.hs b/src/Test/Syd/Def/Specify.hs --- a/src/Test/Syd/Def/Specify.hs +++ b/src/Test/Syd/Def/Specify.hs @@ -175,10 +175,11 @@ sets <- asks testDefEnvTestRunSettings let testDef = TDef - { testDefVal = \supplyArgs -> + { testDefVal = \progressReporter supplyArgs -> runTest t sets + progressReporter ( \func -> supplyArgs (\_ arg2 -> func () arg2) ), testDefCallStack = callStack @@ -276,10 +277,11 @@ sets <- asks testDefEnvTestRunSettings let testDef = TDef - { testDefVal = \supplyArgs -> + { testDefVal = \progressReporter supplyArgs -> runTest t sets + progressReporter (\func -> supplyArgs $ \(HCons outerArgs _) innerArg -> func innerArg outerArgs), testDefCallStack = callStack } @@ -374,10 +376,11 @@ sets <- asks testDefEnvTestRunSettings let testDef = TDef - { testDefVal = \supplyArgs -> + { testDefVal = \progressReporter supplyArgs -> runTest t sets + progressReporter (\func -> supplyArgs $ \(HCons outerArgs _) innerArg -> func outerArgs innerArg), testDefCallStack = callStack } @@ -442,10 +445,11 @@ sets <- asks testDefEnvTestRunSettings let testDef = TDef - { testDefVal = \supplyArgs -> + { testDefVal = \progressReporter supplyArgs -> runTest t sets + progressReporter (\func -> supplyArgs func), testDefCallStack = callStack } diff --git a/src/Test/Syd/OptParse.hs b/src/Test/Syd/OptParse.hs --- a/src/Test/Syd/OptParse.hs +++ b/src/Test/Syd/OptParse.hs @@ -21,6 +21,7 @@ import qualified Options.Applicative.Help as OptParse (string) import Path import Path.IO +import System.Exit import Test.Syd.Run import Text.Colour @@ -68,6 +69,8 @@ settingIterations :: Iterations, -- | Whether to fail when any flakiness is detected settingFailOnFlaky :: !Bool, + -- | How to report progress + settingReportProgress :: !ReportProgress, -- | Debug mode settingDebug :: !Bool } @@ -91,6 +94,7 @@ settingFailFast = False, settingIterations = OneIteration, settingFailOnFlaky = False, + settingReportProgress = ReportNoProgress, settingDebug = False } @@ -119,7 +123,7 @@ ByCapabilities | -- | A given number of threads Asynchronous !Word - deriving (Show, Eq, Generic) + deriving (Show, Read, Eq, Generic) data Iterations = -- | Run the test suite once, the default @@ -128,22 +132,48 @@ Iterations !Word | -- | Run the test suite over and over, until we can find some flakiness Continuous - deriving (Show, Eq, Generic) + deriving (Show, Read, Eq, Generic) +data ReportProgress + = -- | Don't report any progress, the default + ReportNoProgress + | -- | Report progress + ReportProgress + deriving (Show, Read, Eq, Generic) + -- | Combine everything to 'Settings' combineToSettings :: Flags -> Environment -> Maybe Configuration -> IO Settings combineToSettings Flags {..} Environment {..} mConf = do let d func = func defaultSettings let debugMode = fromMaybe (d settingDebug) $ flagDebug <|> envDebug <|> mc configDebug + let threads = + fromMaybe (if debugMode then Synchronous else d settingThreads) $ + flagThreads <|> envThreads <|> mc configThreads + setReportProgress <- + case flagReportProgress <|> envReportProgress <|> mc configReportProgress of + Nothing -> + pure $ + if threads == Synchronous + then + if debugMode + then ReportProgress + else d settingReportProgress + else d settingReportProgress + Just progress -> + if progress + then + if threads /= Synchronous + then die "Reporting progress in asynchronous runners is not supported. You can use --synchronous or --debug to use a synchronous runner." + else pure ReportProgress + else pure ReportNoProgress + pure Settings { settingSeed = fromMaybe (d settingSeed) $ flagSeed <|> envSeed <|> mc configSeed, settingRandomiseExecutionOrder = fromMaybe (if debugMode then False else d settingRandomiseExecutionOrder) $ flagRandomiseExecutionOrder <|> envRandomiseExecutionOrder <|> mc configRandomiseExecutionOrder, - settingThreads = - fromMaybe (if debugMode then Synchronous else d settingThreads) $ - flagThreads <|> envThreads <|> mc configThreads, + settingThreads = threads, settingMaxSuccess = fromMaybe (d settingMaxSuccess) $ flagMaxSuccess <|> envMaxSuccess <|> mc configMaxSuccess, settingMaxSize = fromMaybe (d settingMaxSize) $ flagMaxSize <|> envMaxSize <|> mc configMaxSize, settingMaxDiscard = fromMaybe (d settingMaxDiscard) $ flagMaxDiscard <|> envMaxDiscard <|> mc configMaxDiscard, @@ -158,6 +188,7 @@ (flagFailFast <|> envFailFast <|> mc configFailFast), settingIterations = fromMaybe (d settingIterations) $ flagIterations <|> envIterations <|> mc configIterations, settingFailOnFlaky = fromMaybe (d settingFailOnFlaky) $ flagFailOnFlaky <|> envFailOnFlaky <|> mc configFailOnFlaky, + settingReportProgress = setReportProgress, settingDebug = debugMode } where @@ -185,6 +216,7 @@ configFailFast :: !(Maybe Bool), configIterations :: !(Maybe Iterations), configFailOnFlaky :: !(Maybe Bool), + configReportProgress :: !(Maybe Bool), configDebug :: !(Maybe Bool) } deriving (Show, Eq, Generic) @@ -214,6 +246,7 @@ <*> optionalField "fail-fast" "Whether to stop executing upon the first test failure" .= configFailFast <*> optionalField "iterations" "How many iterations to use to look diagnose flakiness" .= configIterations <*> optionalField "fail-on-flaky" "Whether to fail when any flakiness is detected" .= configFailOnFlaky + <*> optionalField "progress" "How to report progres" .= configReportProgress <*> optionalField "debug" "Turn on debug-mode. This implies randomise-execution-order: false, parallelism: 1 and fail-fast: true" .= configDebug instance HasCodec Threads where @@ -277,6 +310,7 @@ envFailFast :: !(Maybe Bool), envIterations :: !(Maybe Iterations), envFailOnFlaky :: !(Maybe Bool), + envReportProgress :: !(Maybe Bool), envDebug :: !(Maybe Bool) } deriving (Show, Eq, Generic) @@ -299,6 +333,7 @@ envFailFast = Nothing, envIterations = Nothing, envFailOnFlaky = Nothing, + envReportProgress = Nothing, envDebug = Nothing } @@ -329,6 +364,7 @@ <*> 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) "FAIL_ON_FLAKY" (Env.def Nothing <> Env.help "Whether to fail when flakiness is detected") + <*> Env.var (fmap Just . Env.auto) "PROGRESS" (Env.def Nothing <> Env.help "Report progress as tests run") <*> 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 :: Word -> Either e Threads @@ -394,6 +430,7 @@ flagFailFast :: !(Maybe Bool), flagIterations :: !(Maybe Iterations), flagFailOnFlaky :: !(Maybe Bool), + flagReportProgress :: !(Maybe Bool), flagDebug :: !(Maybe Bool) } deriving (Show, Eq, Generic) @@ -416,6 +453,7 @@ flagFailFast = Nothing, flagIterations = Nothing, flagFailOnFlaky = Nothing, + flagReportProgress = Nothing, flagDebug = Nothing } @@ -539,7 +577,8 @@ ) ) <*> doubleSwitch ["fail-on-flaky"] (help "Fail when any flakiness is detected") - <*> doubleSwitch ["debug"] (help "Turn on debug mode. This implies --no-randomise-execution-order, --synchronous and --fail-fast.") + <*> doubleSwitch ["progress"] (help "Report progress") + <*> doubleSwitch ["debug"] (help "Turn on debug mode. This implies --no-randomise-execution-order, --synchronous, --progress and --fail-fast.") seedSettingFlags :: OptParse.Parser (Maybe SeedSetting) seedSettingFlags = diff --git a/src/Test/Syd/Output.hs b/src/Test/Syd/Output.hs --- a/src/Test/Syd/Output.hs +++ b/src/Test/Syd/Output.hs @@ -19,6 +19,7 @@ import Data.Maybe import Data.Text (Text) import qualified Data.Text as T +import Data.Word import GHC.Stack import Safe import Test.QuickCheck.IO () @@ -162,25 +163,16 @@ outputSpecifyLines :: Int -> Int -> Text -> TDef (Timed TestRunResult) -> [[Chunk]] outputSpecifyLines level treeWidth specifyText (TDef (Timed TestRunResult {..} executionTime) _) = - let t = fromIntegral executionTime / 1_000_000 :: Double -- milliseconds - executionTimeText = T.pack (printf "%10.2f ms" t) - withTimingColour = - if - | t < 10 -> fore green - | t < 100 -> fore yellow - | t < 1000 -> fore orange - | t < 10000 -> fore red - | otherwise -> fore darkRed - - withStatusColour = fore (statusColour testRunResultStatus) + let withStatusColour = fore (statusColour testRunResultStatus) pad = (chunk (T.pack (replicate paddingSize ' ')) :) + timeChunk = timeChunkFor executionTime in filter (not . null) $ concat [ [ [ withStatusColour $ chunk (statusCheckMark testRunResultStatus), withStatusColour $ chunk specifyText, - spacingChunk level specifyText executionTimeText treeWidth, - withTimingColour $ chunk executionTimeText + spacingChunk level specifyText (chunkText timeChunk) treeWidth, + timeChunk ] ], map pad $ retriesChunks testRunResultStatus testRunResultRetries testRunResultFlakinessMessage, @@ -199,6 +191,26 @@ map pad $ tablesChunks testRunResultTables, [pad $ outputGoldenCase gc | gc <- maybeToList testRunResultGoldenCase] ] + +exampleNrChunk :: Word -> Word -> Chunk +exampleNrChunk total current = + let digits :: Word + digits = max 2 $ succ $ floor $ logBase 10 $ (fromIntegral :: Word -> Double) total + formatStr = "%" <> show digits <> "d" + in chunk $ T.pack $ printf formatStr current + +timeChunkFor :: Word64 -> Chunk +timeChunkFor executionTime = + let t = fromIntegral executionTime / 1_000_000 :: Double -- milliseconds + executionTimeText = T.pack (printf "%10.2f ms" t) + withTimingColour = + if + | t < 10 -> fore green + | t < 100 -> fore yellow + | t < 1000 -> fore orange + | t < 10000 -> fore red + | otherwise -> fore darkRed + in withTimingColour $ chunk executionTimeText retriesChunks :: TestStatus -> Maybe Int -> Maybe String -> [[Chunk]] retriesChunks status mRetries mMessage = case mRetries of diff --git a/src/Test/Syd/Run.hs b/src/Test/Syd/Run.hs --- a/src/Test/Syd/Run.hs +++ b/src/Test/Syd/Run.hs @@ -14,6 +14,7 @@ import Autodocodec import Control.Concurrent +import Control.Concurrent.STM import Control.Exception import Control.Monad.IO.Class import Control.Monad.Reader @@ -43,6 +44,7 @@ runTest :: e -> TestRunSettings -> + ProgressReporter -> ((Arg1 e -> Arg2 e -> IO ()) -> IO ()) -> IO TestRunResult @@ -64,14 +66,18 @@ runPureTestWithArg :: (outerArgs -> innerArg -> Bool) -> TestRunSettings -> + ProgressReporter -> ((outerArgs -> innerArg -> IO ()) -> IO ()) -> IO TestRunResult -runPureTestWithArg computeBool TestRunSettings {} wrapper = do +runPureTestWithArg computeBool TestRunSettings {} progressReporter wrapper = do + let report = reportProgress progressReporter let testRunResultNumTests = Nothing let testRunResultRetries = Nothing + report ProgressTestStarting resultBool <- applyWrapper2 wrapper $ \outerArgs innerArg -> evaluate (computeBool outerArgs innerArg) + report ProgressTestDone let (testRunResultStatus, testRunResultException) = case resultBool of Left ex -> (TestFailed, Just ex) Right bool -> (if bool then TestPassed else TestFailed, Nothing) @@ -129,15 +135,22 @@ runIOTestWithArg :: (outerArgs -> innerArg -> IO ()) -> TestRunSettings -> + ProgressReporter -> ((outerArgs -> innerArg -> IO ()) -> IO ()) -> IO TestRunResult -runIOTestWithArg func TestRunSettings {} wrapper = do +runIOTestWithArg func TestRunSettings {} progressReporter wrapper = do + let report = reportProgress progressReporter + let testRunResultNumTests = Nothing let testRunResultRetries = Nothing + + report ProgressTestStarting result <- liftIO $ applyWrapper2 wrapper $ \outerArgs innerArg -> func outerArgs innerArg >>= evaluate + report ProgressTestDone + let (testRunResultStatus, testRunResultException) = case result of Left ex -> (TestFailed, Just ex) Right () -> (TestPassed, Nothing) @@ -180,13 +193,31 @@ } runPropertyTestWithArg :: + forall outerArgs innerArg. (outerArgs -> innerArg -> Property) -> TestRunSettings -> + ProgressReporter -> ((outerArgs -> innerArg -> IO ()) -> IO ()) -> IO TestRunResult -runPropertyTestWithArg p trs wrapper = do +runPropertyTestWithArg p trs progressReporter wrapper = do + let report = reportProgress progressReporter let qcargs = makeQuickCheckArgs trs - qcr <- quickCheckWithResult qcargs (aroundProperty wrapper p) + + exampleCounter <- newTVarIO 1 + let totalExamples = (fromIntegral :: Int -> Word) (maxSuccess qcargs) + let wrapperWithProgress :: (outerArgs -> innerArg -> IO ()) -> IO () + wrapperWithProgress func = wrapper $ \outers inner -> do + exampleNr <- readTVarIO exampleCounter + report $ ProgressExampleStarting totalExamples exampleNr + timedResult <- timeItT $ func outers inner + report $ ProgressExampleDone totalExamples exampleNr $ timedTime timedResult + atomically $ modifyTVar' exampleCounter succ + pure $ timedValue timedResult + + report ProgressTestStarting + qcr <- quickCheckWithResult qcargs (aroundProperty wrapperWithProgress p) + report ProgressTestDone + let testRunResultGoldenCase = Nothing let testRunResultNumTests = Just $ fromIntegral $ numTests qcr let testRunResultRetries = Nothing @@ -308,9 +339,10 @@ runGoldenTestWithArg :: (outerArgs -> innerArg -> IO (GoldenTest a)) -> TestRunSettings -> + ProgressReporter -> ((outerArgs -> innerArg -> IO ()) -> IO ()) -> IO TestRunResult -runGoldenTestWithArg createGolden TestRunSettings {..} wrapper = do +runGoldenTestWithArg createGolden TestRunSettings {..} _ wrapper = do errOrTrip <- applyWrapper2 wrapper $ \outerArgs innerArgs -> do GoldenTest {..} <- createGolden outerArgs innerArgs mGolden <- goldenTestRead @@ -440,6 +472,31 @@ | GoldenStarted | GoldenReset deriving (Show, Eq, Typeable, Generic) + +type ProgressReporter = Progress -> IO () + +noProgressReporter :: ProgressReporter +noProgressReporter _ = pure () + +reportProgress :: ProgressReporter -> Progress -> IO () +reportProgress = id + +data Progress + = ProgressTestStarting + | ProgressExampleStarting + !Word + -- ^ Total examples + !Word + -- ^ Example number + | ProgressExampleDone + !Word + -- ^ Total examples + !Word + -- ^ Example number + !Word64 + -- ^ Time it took + | ProgressTestDone + deriving (Show, Eq, Generic) -- | Time an action and return the result as well as how long it took in seconds. -- diff --git a/src/Test/Syd/Runner/Asynchronous.hs b/src/Test/Syd/Runner/Asynchronous.hs --- a/src/Test/Syd/Runner/Asynchronous.hs +++ b/src/Test/Syd/Runner/Asynchronous.hs @@ -71,7 +71,7 @@ mDone <- tryReadMVar failFastVar case mDone of Nothing -> do - let runNow = timeItT $ runSingleTestWithFlakinessMode a td fm + let runNow = timeItT $ runSingleTestWithFlakinessMode noProgressReporter a td fm -- Wait before spawning a thread so that we don't spawn too many threads let quantity = case p of -- When the test wants to be executed sequentially, we take n locks because we must make sure that diff --git a/src/Test/Syd/Runner/Synchronous.hs b/src/Test/Syd/Runner/Synchronous.hs --- a/src/Test/Syd/Runner/Synchronous.hs +++ b/src/Test/Syd/Runner/Synchronous.hs @@ -36,7 +36,7 @@ goTree :: forall a. FlakinessMode -> HList a -> TestTree a () -> IO (Next ResultTree) goTree fm hl = \case DefSpecifyNode t td () -> do - result <- timeItT $ runSingleTestWithFlakinessMode hl td fm + result <- timeItT $ runSingleTestWithFlakinessMode noProgressReporter hl td fm let td' = td {testDefVal = result} let r = failFastNext (settingFailFast settings) td' pure $ SpecifyNode t <$> r @@ -82,7 +82,27 @@ goTree :: Int -> FlakinessMode -> HList a -> TestTree a () -> IO (Next ResultTree) goTree level fm hl = \case DefSpecifyNode t td () -> do - result <- timeItT $ runSingleTestWithFlakinessMode hl td fm + let progressReporter :: Progress -> IO () + progressReporter = + outputLine . pad (succ (succ level)) . \case + ProgressTestStarting -> + [ fore cyan "Test starting: ", + fore yellow $ chunk t + ] + ProgressExampleStarting totalExamples exampleNr -> + [ fore cyan "Example starting: ", + fore yellow $ exampleNrChunk totalExamples exampleNr + ] + ProgressExampleDone totalExamples exampleNr executionTime -> + [ fore cyan "Example done: ", + fore yellow $ exampleNrChunk totalExamples exampleNr, + timeChunkFor executionTime + ] + ProgressTestDone -> + [ fore cyan "Test done: ", + fore yellow $ chunk t + ] + result <- timeItT $ runSingleTestWithFlakinessMode progressReporter hl td fm let td' = td {testDefVal = result} mapM_ (outputLine . pad level) $ outputSpecifyLines level treeWidth t td' let r = failFastNext (settingFailFast settings) td' @@ -119,8 +139,8 @@ pure resultForest -runSingleTestWithFlakinessMode :: forall a t. HList a -> TDef (((HList a -> () -> t) -> t) -> IO TestRunResult) -> FlakinessMode -> IO TestRunResult -runSingleTestWithFlakinessMode l td = \case +runSingleTestWithFlakinessMode :: forall a t. ProgressReporter -> HList a -> TDef (ProgressReporter -> ((HList a -> () -> t) -> t) -> IO TestRunResult) -> FlakinessMode -> IO TestRunResult +runSingleTestWithFlakinessMode progressReporter l td = \case MayNotBeFlaky -> runFunc MayBeFlakyUpTo retries mMsg -> updateFlakinessMessage <$> go retries where @@ -145,4 +165,5 @@ Just r -> Just (succ r) } where - runFunc = testDefVal td (\f -> f l ()) + runFunc :: IO TestRunResult + runFunc = testDefVal td progressReporter (\f -> f l ()) diff --git a/src/Test/Syd/SpecDef.hs b/src/Test/Syd/SpecDef.hs --- a/src/Test/Syd/SpecDef.hs +++ b/src/Test/Syd/SpecDef.hs @@ -59,7 +59,7 @@ -- | The description of the test Text -> -- | How the test can be run given a function that provides the resources - TDef (((HList outers -> inner -> IO ()) -> IO ()) -> IO TestRunResult) -> + TDef (ProgressReporter -> ((HList outers -> inner -> IO ()) -> IO ()) -> IO TestRunResult) -> extra -> SpecDefTree outers inner extra -- | Define a pending test diff --git a/sydtest.cabal b/sydtest.cabal --- a/sydtest.cabal +++ b/sydtest.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: sydtest -version: 0.8.0.1 +version: 0.9.0.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 @@ -84,6 +84,7 @@ , safe , safe-coloured-text , split + , stm , text , yaml if os(windows) diff --git a/test/Test/Syd/OptParseSpec.hs b/test/Test/Syd/OptParseSpec.hs --- a/test/Test/Syd/OptParseSpec.hs +++ b/test/Test/Syd/OptParseSpec.hs @@ -25,6 +25,7 @@ { settingThreads = Synchronous, settingRandomiseExecutionOrder = False, settingFailFast = True, + settingReportProgress = ReportProgress, settingDebug = True } combineToSettings flags environment mConf `shouldReturn` settings diff --git a/test/Test/Syd/TimingSpec.hs b/test/Test/Syd/TimingSpec.hs --- a/test/Test/Syd/TimingSpec.hs +++ b/test/Test/Syd/TimingSpec.hs @@ -25,7 +25,7 @@ threadDelay 100_000 it "takes at least 100 milliseconds (property) " $ property $ \() -> do - threadDelay 1_000 + threadDelay 10_000 {-# NOINLINE take10ms #-} take10ms :: IO () diff --git a/test_resources/defaultSettings-show.golden b/test_resources/defaultSettings-show.golden --- a/test_resources/defaultSettings-show.golden +++ b/test_resources/defaultSettings-show.golden @@ -13,5 +13,6 @@ , settingFailFast = False , settingIterations = OneIteration , settingFailOnFlaky = False + , settingReportProgress = ReportNoProgress , settingDebug = False }