Make ghcDebugAssertions into a Stage predicate (Stage -> Bool)

We also care whether we have debug assertions enabled for a stage one
compiler, but the way which we turned on the assertions was quite
different from the stage2 compiler. This makes the logic for turning on
consistent across both and has the advantage of being able to correct
determine in in-tree args whether a flavour enables assertions or not.

Ticket #22096

7 files changed, 14 insertions, 11 deletions

diff --git a/hadrian/src/Flavour.hs b/hadrian/src/Flavour.hs
index 3b81c3fd77..e49ec68964 100644
--- a/hadrian/src/Flavour.hs
+++ b/hadrian/src/Flavour.hs
@@ -241,7 +241,10 @@ enableLateCCS = addArgs
 
 -- | Enable assertions for the stage2 compiler
 enableAssertions :: Flavour -> Flavour
-enableAssertions flav = flav { ghcDebugAssertions = True }
+enableAssertions flav = flav { ghcDebugAssertions = f }
+  where
+    f Stage2 = True
+    f st = ghcDebugAssertions flav st
 
 -- | Produce fully statically-linked executables and build libraries suitable
 -- for static linking.
diff --git a/hadrian/src/Flavour/Type.hs b/hadrian/src/Flavour/Type.hs
index ed3730a006..7718d63d7f 100644
--- a/hadrian/src/Flavour/Type.hs
+++ b/hadrian/src/Flavour/Type.hs
@@ -35,7 +35,7 @@ data Flavour = Flavour {
     -- | Build GHC with the debug RTS.
     ghcDebugged :: Stage -> Bool,
     -- | Build GHC with debug assertions.
-    ghcDebugAssertions :: Bool,
+    ghcDebugAssertions :: Stage -> Bool,
     -- | Build the GHC executable against the threaded runtime system.
     ghcThreaded :: Stage -> Bool,
     -- | Whether to build docs and which ones
diff --git a/hadrian/src/Settings/Builders/RunTest.hs b/hadrian/src/Settings/Builders/RunTest.hs
index 5551cf1b35..13eb146134 100644
--- a/hadrian/src/Settings/Builders/RunTest.hs
+++ b/hadrian/src/Settings/Builders/RunTest.hs
@@ -100,9 +100,7 @@ inTreeCompilerArgs stg = do
     withInterpreter     <- ghcWithInterpreter
     unregisterised      <- flag GhcUnregisterised
     withSMP             <- targetSupportsSMP
-    debugAssertions     <- if stg >= Stage2
-                            then ghcDebugAssertions <$> flavour
-                            else return False
+    debugAssertions     <- ($ stg) . ghcDebugAssertions <$> flavour
     profiled            <- ghcProfiled        <$> flavour <*> pure stg
 
     os          <- setting HostOs
diff --git a/hadrian/src/Settings/Default.hs b/hadrian/src/Settings/Default.hs
index 6aad1648fd..4711421fc9 100644
--- a/hadrian/src/Settings/Default.hs
+++ b/hadrian/src/Settings/Default.hs
@@ -240,7 +240,7 @@ defaultFlavour = Flavour
     , ghcProfiled        = const False
     , ghcDebugged        = const False
     , ghcThreaded        = const True
-    , ghcDebugAssertions = False
+    , ghcDebugAssertions = const False
     , ghcDocs            = cmdDocsArgs }
 
 -- | Default logic for determining whether to build
diff --git a/hadrian/src/Settings/Flavours/Development.hs b/hadrian/src/Settings/Flavours/Development.hs
index 00831012cc..835584d3eb 100644
--- a/hadrian/src/Settings/Flavours/Development.hs
+++ b/hadrian/src/Settings/Flavours/Development.hs
@@ -15,7 +15,7 @@ developmentFlavour ghcStage = defaultFlavour
     , libraryWays = pure $ Set.fromList [vanilla]
     , rtsWays = pure $ Set.fromList [vanilla, debug, threaded, threadedDebug]
     , dynamicGhcPrograms = return False
-    , ghcDebugAssertions = True }
+    , ghcDebugAssertions = (>= Stage2) }
     where
       stageString Stage2 = "2"
       stageString Stage1 = "1"
diff --git a/hadrian/src/Settings/Flavours/Validate.hs b/hadrian/src/Settings/Flavours/Validate.hs
index ce73726bfd..7ecc97cf37 100644
--- a/hadrian/src/Settings/Flavours/Validate.hs
+++ b/hadrian/src/Settings/Flavours/Validate.hs
@@ -23,6 +23,7 @@ validateFlavour = enableLinting $ werror $ defaultFlavour
                             [ dynamic, threadedDynamic, debugDynamic, threadedDebugDynamic
                             ]
                         ]
+    , ghcDebugAssertions = (<= Stage1)
     }
 
 validateArgs :: Args
@@ -33,15 +34,16 @@ validateArgs = sourceArgs SourceArgs
                            , notStage0 ? arg "-dno-debug-output"
                            ]
     , hsLibrary  = pure ["-O"]
-    , hsCompiler = mconcat [ stage0 ? pure ["-O2", "-DDEBUG"]
+    , hsCompiler = mconcat [ stage0 ? pure ["-O2"]
                            , notStage0 ? pure ["-O" ]
                            ]
     , hsGhc      = pure ["-O"] }
 
+
 slowValidateFlavour :: Flavour
 slowValidateFlavour = validateFlavour
     { name = "slow-validate"
-    , ghcDebugAssertions = True
+    , ghcDebugAssertions = const True
     }
 
 quickValidateArgs :: Args
diff --git a/hadrian/src/Settings/Packages.hs b/hadrian/src/Settings/Packages.hs
index 0eb887e662..db0db16902 100644
--- a/hadrian/src/Settings/Packages.hs
+++ b/hadrian/src/Settings/Packages.hs
@@ -52,7 +52,7 @@ packageArgs = do
           [ builder Alex ? arg "--latin1"
 
           , builder (Ghc CompileHs) ? mconcat
-            [ debugAssertions ? notStage0 ? arg "-DDEBUG"
+            [ debugAssertions stage ?  arg "-DDEBUG"
 
             , inputs ["**/GHC.hs", "**/GHC/Driver/Make.hs"] ? arg "-fprof-auto"
             , input "**/Parser.hs" ?
@@ -83,7 +83,7 @@ packageArgs = do
         , package ghc ? mconcat
           [ builder Ghc ? mconcat
              [ arg ("-I" ++ compilerPath)
-             , debugAssertions ? notStage0 ? arg "-DDEBUG" ]
+             , debugAssertions stage ? arg "-DDEBUG" ]
 
           , builder (Cabal Flags) ? mconcat
             [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter"