From 5f4b56eab8d3a7bf12501fc96b6efd1e4427a478 Mon Sep 17 00:00:00 2001
From: Kristen Kozak <grayjay@wordroute.com>
Date: Mon, 29 Jul 2024 22:51:45 -0700
Subject: [PATCH] Add simple QuickCheck test for solver exceptions

The solver QuickCheck tests can already detect exceptions, but this test is
simpler and easier to debug.
---
 .../Distribution/Solver/Modular/QuickCheck.hs | 20 ++++++++++++++++++-
 1 file changed, 19 insertions(+), 1 deletion(-)

diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs
index 1a2bc97224f..c891f60692b 100644
--- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs
+++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs
@@ -52,7 +52,20 @@ import UnitTests.Distribution.Solver.Modular.QuickCheck.Utils
 
 tests :: [TestTree]
 tests =
-  [ -- This test checks that certain solver parameters do not affect the
+  [ testPropertyWithSeed "solver does not throw exceptions" $
+      \test goalOrder reorderGoals indepGoals prefOldest ->
+        let r =
+              solve
+                (EnableBackjumping True)
+                (FineGrainedConflicts True)
+                reorderGoals
+                (CountConflicts True)
+                indepGoals
+                prefOldest
+                (getBlind <$> goalOrder)
+                test
+         in resultPlan r `seq` ()
+  , -- This test checks that certain solver parameters do not affect the
     -- existence of a solution. It runs the solver twice, and only sets those
     -- parameters on the second run. The test also applies parameters that
     -- can affect the existence of a solution to both runs.
@@ -516,6 +529,11 @@ instance Arbitrary IndependentGoals where
 
   shrink (IndependentGoals indep) = [IndependentGoals False | indep]
 
+instance Arbitrary PreferOldest where
+  arbitrary = PreferOldest <$> arbitrary
+
+  shrink (PreferOldest prefOldest) = [PreferOldest False | prefOldest]
+
 instance Arbitrary Component where
   arbitrary =
     oneof