Merge pull request UnkindPartition#340 from martijnbastiaan/print-cycles

Print dependency cycles in error message

README.md

@@ -112,7 +112,7 @@ The following providers exist:
   (based on [LeanCheck](https://hackage.haskell.org/package/leancheck))
 * [tasty-program](https://hackage.haskell.org/package/tasty-program) — run
   external program and test whether it terminates successfully
-* [tasty-wai](https://hackage.haskell.org/package/tasty-wai) — 
+* [tasty-wai](https://hackage.haskell.org/package/tasty-wai) —
   for testing [wai](https://hackage.haskell.org/wai) endpoints.
 * [tasty-inspection-testing](https://hackage.haskell.org/package/tasty-inspection-testing) —
   for compile-time testing of code properties
@@ -755,7 +755,7 @@ Here are some caveats to keep in mind regarding dependencies in Tasty:
    typos. Fortunately, misspecified dependencies usually lead to test failures
    and so can be detected that way.
 1. Dependencies shouldn't form a cycle, otherwise Tasty with fail with the
-   message "Test dependencies form a loop." A common cause of this is a test
+   message "Test dependencies have cycles." A common cause of this is a test
    matching its own dependency pattern.
 1. Using dependencies may introduce quadratic complexity. Specifically,
    resolving dependencies is *O(number_of_tests × number_of_dependencies)*,
@@ -798,11 +798,11 @@ Here are some caveats to keep in mind regarding dependencies in Tasty:
     See [issue #152](https://github.com/UnkindPartition/tasty/issues/152).
 
 3. **Q**: Patterns with slashes do not work on Windows. How can I fix it?
-  
-   **A**: If you are running Git for Windows terminal, it has a habit of converting slashes 
-   to backslashes. Set `MSYS_NO_PATHCONV=1` to prevent this behaviour, or follow other 
+
+   **A**: If you are running Git for Windows terminal, it has a habit of converting slashes
+   to backslashes. Set `MSYS_NO_PATHCONV=1` to prevent this behaviour, or follow other
    suggestions from [Known Issues](https://github.com/git-for-windows/build-extra/blob/main/ReleaseNotes.md#known-issues).
-   
+
 ## Press
 
 Blog posts and other publications related to tasty. If you wrote or just found

core-tests/Dependencies.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedLists #-}
+
 module Dependencies (testDependencies) where
 
 import Test.Tasty
@@ -10,10 +12,12 @@ import Text.Printf
 import qualified Data.IntMap as IntMap
 import Control.Monad
 import Control.Exception
+import Data.List (intercalate)
 
 testDependencies :: TestTree
 testDependencies = testGroup "Dependencies" $
   generalDependencyTests ++
+  [circDepShow] ++
   circDepTests ++
   [resourceDependenciesTest]
 
@@ -26,6 +30,17 @@ testTree deptype succeed =
     , testCase "Three" $ threadDelay 1e6 >> assertBool "fail" succeed
     ]
 
+circDepShow :: TestTree
+circDepShow = testCase "show DependencyLoop" $
+  assertEqual
+    "dependency cycles should be shown on separate lines"
+    (show (DependencyLoop [[["a", "foo"], ["b"]], [["c"], ["d", "bar"]]]))
+    (intercalate "\n"
+      [ "Test dependencies have cycles:"
+      , "- a.foo, b, a.foo"
+      , "- c, d.bar, c"
+      ])
+
 -- an example of a tree with circular dependencies
 circDepTree1 :: TestTree
 circDepTree1 = after AllSucceed "One" $ testCase "One" $ return ()
@@ -40,12 +55,25 @@ circDepTree2 = testGroup "dependency test"
 
 circDepTests :: [TestTree]
 circDepTests = do
-  (i, tree) <- zip [1,2] [circDepTree1, circDepTree2]
+  (i, expectedCycles, tree) <-
+    zip3
+      [1,2]
+      [circDeps1, circDeps2]
+      [circDepTree1, circDepTree2]
+
   return $ testCase ("Circular dependencies " ++ show i) $ do
     r <- try $ launchTestTree mempty tree $ \_ -> return $ \_ -> return ()
     case r of
-      Left DependencyLoop -> return ()
+      Left (DependencyLoop cycles) ->
+        assertEqual "Unexpected cycles" expectedCycles cycles
       _ -> assertFailure $ show r
+  where
+    circDeps1 = [[["One"]]]
+    circDeps2 = [[
+        ["dependency test", "One"]
+      , ["dependency test", "Three"]
+      , ["dependency test", "Two"]
+      ]]
 
 -- | Check the semantics of dependencies
 generalDependencyTests :: [TestTree]

core/CHANGELOG.md

@@ -1,6 +1,13 @@
 Changes
 =======
 
+Unreleased
+---------------
+
+_YYYY-MM-DD_
+
+- Dependency loop error now lists all test cases that formed a cycle
+
 Version 1.4.2.3
 ---------------
 

core/Test/Tasty/Run.hs

@@ -1,6 +1,7 @@
 -- | Running tests
 {-# LANGUAGE ScopedTypeVariables, ExistentialQuantification, RankNTypes,
-             FlexibleContexts, BangPatterns, CPP, DeriveDataTypeable #-}
+             FlexibleContexts, BangPatterns, CPP, DeriveDataTypeable,
+             LambdaCase #-}
 module Test.Tasty.Run
   ( Status(..)
   , StatusMap
@@ -12,6 +13,7 @@ import qualified Data.IntMap as IntMap
 import qualified Data.Sequence as Seq
 import qualified Data.Foldable as F
 import Data.Maybe
+import Data.List (intercalate)
 import Data.Graph (SCC(..), stronglyConnComp)
 import Data.Typeable
 import Control.Monad (forever, guard, join, liftM)
@@ -219,14 +221,21 @@ type Tr = Traversal
 
 -- | Exceptions related to dependencies between tests.
 data DependencyException
-  = DependencyLoop
-    -- ^ Test dependencies form a loop. In other words, test A cannot start
+  = DependencyLoop [[Path]]
+    -- ^ Test dependencies form cycles. In other words, test A cannot start
     -- until test B finishes, and test B cannot start until test
-    -- A finishes.
+    -- A finishes. Field lists detected cycles.
   deriving (Typeable)
 
 instance Show DependencyException where
-  show DependencyLoop = "Test dependencies form a loop."
+  show (DependencyLoop css) = "Test dependencies have cycles:\n" ++ showCycles css
+    where
+      showCycles = intercalate "\n" . map showCycle
+      showPath = intercalate "." . F.toList
+
+      -- For clarity in the error message, the first element is repeated at the end
+      showCycle []     = "- <empty cycle>"
+      showCycle (x:xs) = "- " ++ intercalate ", " (map showPath (x:xs ++ [x]))
 
 instance Exception DependencyException
 
@@ -252,14 +261,14 @@ createTestActions opts0 tree = do
         opts0 tree
   (tests, fins) <- unwrap (mempty :: Path) (mempty :: Deps) traversal
   let
-    mb_tests :: Maybe [(Action, TVar Status)]
+    mb_tests :: Either [[Path]] [(Action, TVar Status)]
     mb_tests = resolveDeps $ map
       (\(act, testInfo) ->
         (act (Seq.empty, Seq.empty), testInfo))
       tests
   case mb_tests of
-    Just tests' -> return (tests', fins)
-    Nothing -> throwIO DependencyLoop
+    Right tests' -> return (tests', fins)
+    Left cycles -> throwIO (DependencyLoop cycles)
 
   where
     runSingleTest :: IsTest t => OptionSet -> TestName -> t -> Tr
@@ -297,8 +306,10 @@ createTestActions opts0 tree = do
 
 -- | Take care of the dependencies.
 --
--- Return 'Nothing' if there is a dependency cycle.
-resolveDeps :: [(IO (), (TVar Status, Path, Deps))] -> Maybe [(Action, TVar Status)]
+-- Return 'Left' if there is a dependency cycle, containing the detected cycles.
+resolveDeps
+  :: [(IO (), (TVar Status, Path, Deps))]
+  -> Either [[Path]] [(Action, TVar Status)]
 resolveDeps tests = checkCycles $ do
   (run_test, (statusVar, path0, deps)) <- tests
   let
@@ -340,18 +351,20 @@ resolveDeps tests = checkCycles $ do
       }
   return ((action, statusVar), (path0, dep_paths))
 
-checkCycles :: Ord b => [(a, (b, [b]))] -> Maybe [a]
+checkCycles :: Ord b => [(a, (b, [b]))] -> Either [[b]] [a]
 checkCycles tests = do
   let
     result = fst <$> tests
-    graph = [ ((), v, vs) | (v, vs) <- snd <$> tests ]
+    graph = [ (v, v, vs) | (v, vs) <- snd <$> tests ]
     sccs = stronglyConnComp graph
-    not_cyclic = all (\scc -> case scc of
-        AcyclicSCC{} -> True
-        CyclicSCC{}  -> False)
-      sccs
-  guard not_cyclic
-  return result
+    cycles =
+      flip mapMaybe sccs $ \case
+        AcyclicSCC{} -> Nothing
+        CyclicSCC vs -> Just vs
+
+  case cycles of
+    [] -> Right result
+    _  -> Left cycles
 
 -- | Used to create the IO action which is passed in a WithResource node
 getResource :: TVar (Resource r) -> IO r