properties for find_cycle

Author: MaximilianAlgehed

test/Constrained/GraphSpec.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE ImportQualifiedPost #-}
@@ -68,6 +69,24 @@ prop_topsort_sound g =
     go [] = True
     go (n : ns) = all (\n' -> not $ dependsOn n n' g) ns && go ns
 
+prop_find_cycle_sound :: Property
+prop_find_cycle_sound =
+  forAllShrink (mkGraph @Node <$> arbitrary) shrink $ \ g ->
+    and [ all (\(x, y) -> dependsOn x y g) (zip c (drop 1 c))
+        | n <- Set.toList $ nodes g
+        , let c = findCycle g n
+        ]
+
+prop_find_cycle_loops :: Property
+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
+      | n <- Set.toList $ nodes g
+      ]
+
 tests :: Bool -> Spec
 tests _nightly =
   describe "Graph tests" $ do
@@ -80,3 +99,5 @@ tests _nightly =
     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