fix findCycle (not the nicest fix) and add coverage requirements for the

tests

Author: MaximilianAlgehed

src/Constrained/Graph.hs

@@ -171,8 +171,10 @@ topsort gr@(Graph e _) = go [] e
 -- | Simple DFS cycle finding
 -- TODO: tests for this, currently it can produce a stem with a cycle after it
 findCycle :: Ord node => Graph node -> node -> [node]
-findCycle (Graph e _) node = concat . take 1 $ go mempty node
+findCycle g@(Graph e _) node = concat . take 1 $ filter loopy $ go mempty node
   where
+    loopy [] = False
+    loopy c@(x:_) = dependsOn (last c) x g
     go seen n
       | n `Set.member` seen = [[]]
       | otherwise = do

test/Constrained/GraphSpec.hs

@@ -37,11 +37,13 @@ prop_delete_topsort g n =
 
 prop_op_topsort :: Graph Node -> Property
 prop_op_topsort g =
-  isRight (topsort g) === isRight (topsort $ opGraph g)
+  cover 60 (isRight (topsort g)) "has topsort" $
+    isRight (topsort g) == isRight (topsort $ opGraph g)
 
 prop_trC_topsort :: Graph Node -> Property
 prop_trC_topsort g =
-  isRight (topsort g) === isRight (topsort $ transitiveClosure g)
+  cover 60 (isRight (topsort g)) "has topsort" $
+    isRight (topsort g) == isRight (topsort $ transitiveClosure g)
 
 prop_trC_opgraph_commute :: Graph Node -> Property
 prop_trC_opgraph_commute g =
@@ -58,13 +60,13 @@ prop_topsort_all_nodes :: Graph Node -> Property
 prop_topsort_all_nodes g =
   case topsort g of
     Left{} -> discard
-    Right o -> Set.fromList o === nodes g
+    Right o -> cover 60 True "has topsort" $ Set.fromList o === nodes g
 
 prop_topsort_sound :: Graph Node -> Property
 prop_topsort_sound g =
   case topsort g of
     Left{} -> discard
-    Right o -> property $ go o
+    Right o -> cover 60 True "has topsort" $ property $ go o
   where
     go [] = True
     go (n : ns) = all (\n' -> not $ dependsOn n n' g) ns && go ns
@@ -82,22 +84,22 @@ prop_find_cycle_loops =
   forAllShrink (mkGraph @Node <$> arbitrary) shrink $ \ g ->
     conjoin
       [ case findCycle g n of
-          [] -> discard
-          c@(x:_) -> counterexample (show c) $ dependsOn (last c) x g
+          [] -> property True
+          c@(x:_) -> cover 40 True "found cycle" $ counterexample (show c) $ dependsOn (last c) x g
       | n <- Set.toList $ nodes g
       ]
 
 tests :: Bool -> Spec
 tests _nightly =
   describe "Graph tests" $ do
-    prop "prop_no_dependencies_topsort" $ withMaxSuccess 10000 prop_no_dependencies_topsort
-    prop "prop_subtract_topsort"        $ withMaxSuccess 10000 prop_subtract_topsort
-    prop "prop_delete_topsort"          $ withMaxSuccess 10000 prop_delete_topsort
-    prop "prop_op_topsort"              $ withMaxSuccess 10000 prop_op_topsort
-    prop "prop_trC_topsort"             $ withMaxSuccess 10000 prop_trC_topsort
-    prop "prop_trC_opgraph_commute"     $ withMaxSuccess 10000 prop_trC_opgraph_commute
-    prop "prop_depends_grows"           $ withMaxSuccess 10000 prop_depends_grows
-    prop "prop_topsort_all_nodes"       $ withMaxSuccess 10000 prop_topsort_all_nodes
-    prop "prop_topsort_sound"           $ withMaxSuccess 10000 prop_topsort_sound
-    prop "prop_find_cycle_sound"        $ withMaxSuccess 10000 prop_find_cycle_sound
-    prop "prop_find_cycle_loops"        $ withMaxSuccess 10000 prop_find_cycle_loops
+    prop "prop_no_dependencies_topsort" $ checkCoverage $ withMaxSuccess 10000 prop_no_dependencies_topsort
+    prop "prop_subtract_topsort"        $ checkCoverage $ withMaxSuccess 10000 prop_subtract_topsort
+    prop "prop_delete_topsort"          $ checkCoverage $ withMaxSuccess 10000 prop_delete_topsort
+    prop "prop_op_topsort"              $ checkCoverage $ withMaxSuccess 10000 prop_op_topsort
+    prop "prop_trC_topsort"             $ checkCoverage $ withMaxSuccess 10000 prop_trC_topsort
+    prop "prop_trC_opgraph_commute"     $ checkCoverage $ withMaxSuccess 10000 prop_trC_opgraph_commute
+    prop "prop_depends_grows"           $ checkCoverage $ withMaxSuccess 10000 prop_depends_grows
+    prop "prop_topsort_all_nodes"       $ checkCoverage $ withMaxSuccess 10000 prop_topsort_all_nodes
+    prop "prop_topsort_sound"           $ checkCoverage $ withMaxSuccess 10000 prop_topsort_sound
+    prop "prop_find_cycle_sound"        $ checkCoverage $ withMaxSuccess 10000 prop_find_cycle_sound
+    prop "prop_find_cycle_loops"        $ checkCoverage $ withMaxSuccess 10000 prop_find_cycle_loops