From 7450612272e4b5e7815969a30f3a9f91149b86e1 Mon Sep 17 00:00:00 2001 From: Roman Cheplyaka Date: Wed, 15 Sep 2021 19:46:34 +0300 Subject: [PATCH] Improve the performance by avoiding spinning in ppProgressOrResult --- core/Test/Tasty/Ingredients/ConsoleReporter.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/core/Test/Tasty/Ingredients/ConsoleReporter.hs b/core/Test/Tasty/Ingredients/ConsoleReporter.hs index bfed305d..b36e8657 100644 --- a/core/Test/Tasty/Ingredients/ConsoleReporter.hs +++ b/core/Test/Tasty/Ingredients/ConsoleReporter.hs @@ -242,11 +242,13 @@ foldTestOutput foldTest foldHeading outputTree smap = -------------------------------------------------- ppProgressOrResult :: TVar Status -> (Progress -> IO ()) -> IO Result -ppProgressOrResult statusVar ppProgress = go where - go = either (\p -> ppProgress p *> go) return =<< (atomically $ do +ppProgressOrResult statusVar ppProgress = go emptyProgress where + go old_p = either (\p -> ppProgress p *> go p) return =<< (atomically $ do status <- readTVar statusVar case status of - Executing p -> pure $ Left p + Executing p + | p == old_p -> retry + | otherwise -> pure $ Left p Done r -> pure $ Right r _ -> retry )