Improve the performance by avoiding spinning in ppProgressOrResult

UnkindPartition · Sep 15, 2021 · 7450612 · 7450612
1 parent 50a9871
commit 7450612
Showing 1 changed file with 5 additions and 3 deletions.
diff --git 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
     )