Control expensive assertions in cabal-install with a build flag.

I added a build flag, 'debug-assertions', and a function, 'debugAssert'.
'debugAssert' only calls 'assert' when the flag is enabled. I only replaced one
call to 'assert' so far (in Distribution.Solver.Modular.Linking) in order to
resolve haskell#4258.

Author: grayjay

cabal-install/Distribution/Client/Utils/Assertion.hs

@@ -0,0 +1,16 @@
+{-# LANGUAGE CPP #-}
+module Distribution.Client.Utils.Assertion (debugAssert) where
+
+#ifdef DEBUG_ASSERTIONS
+import Control.Exception (assert)
+#endif
+
+-- | Like 'assert', but only enabled with -fdebug-assertions. This function can
+-- be used for expensive assertions that should only be turned on during testing
+-- or debugging.
+debugAssert :: Bool -> a -> a
+#ifdef DEBUG_ASSERTIONS
+debugAssert = assert
+#else
+debugAssert _ = id
+#endif

cabal-install/Distribution/Solver/Modular/Linking.hs

@@ -16,6 +16,7 @@ import qualified Data.Map         as M
 import qualified Data.Set         as S
 import qualified Data.Traversable as T
 
+import Distribution.Client.Utils.Assertion
 import Distribution.Solver.Modular.Assignment
 import Distribution.Solver.Modular.Dependency
 import Distribution.Solver.Modular.Flag
@@ -136,7 +137,7 @@ newtype UpdateState a = UpdateState {
 instance MonadState ValidateState UpdateState where
   get    = UpdateState $ get
   put st = UpdateState $ do
-             assert (lgInvariant $ vsLinks st) $ return ()
+             debugAssert (lgInvariant $ vsLinks st) $ return ()
              put st
 
 lift' :: Either Conflict a -> UpdateState a

cabal-install/cabal-install.cabal

@@ -189,6 +189,11 @@ Flag network-uri
   description:  Get Network.URI from the network-uri package
   default:      True
 
+Flag debug-assertions
+  description:  Enable expensive assertions for testing or debugging
+  default:      False
+  manual:       True
+
 Flag debug-conflict-sets
   description:  Add additional information to ConflictSets
   default:      False
@@ -295,6 +300,7 @@ library
         Distribution.Client.Update
         Distribution.Client.Upload
         Distribution.Client.Utils
+        Distribution.Client.Utils.Assertion
         Distribution.Client.Utils.Json
         Distribution.Client.World
         Distribution.Client.Win32SelfUpgrade
@@ -408,6 +414,9 @@ library
     else
       build-depends: unix >= 2.5 && < 2.8
 
+    if flag(debug-assertions)
+      cpp-options: -DDEBUG_ASSERTIONS
+
     if flag(debug-conflict-sets)
       cpp-options: -DDEBUG_CONFLICT_SETS
       build-depends: base >= 4.8
@@ -497,6 +506,9 @@ executable cabal
         else
           build-depends: unix >= 2.5 && < 2.8
 
+        if flag(debug-assertions)
+          cpp-options: -DDEBUG_ASSERTIONS
+
         if flag(debug-conflict-sets)
           cpp-options: -DDEBUG_CONFLICT_SETS
           build-depends: base >= 4.8