Hadrian: make DDEBUG separate from debugged RTS

This patchs separates whether -DDEBUG is enabled (i.e. whether debug
assertions are enabled) from whether we are using the debugged RTS
(i.e. GhcDebugged = YES).

This means that we properly skip tests which have been marked with
`when(compiler_debugged(), skip)`.

Fixes #21113, #21153 and #21234

8 files changed, 46 insertions, 36 deletions

diff --git a/hadrian/doc/user-settings.md b/hadrian/doc/user-settings.md
index 5b6c5ca65a..0cc7807755 100644
--- a/hadrian/doc/user-settings.md
+++ b/hadrian/doc/user-settings.md
@@ -35,8 +35,10 @@ data Flavour = Flavour {
     ghciWithDebugger :: Bool,
     -- | Build profiled GHC.
     ghcProfiled :: Bool,
-    -- | Build GHC with debug information.
-    ghcDebugged :: Bool
+    -- | Build GHC with the debug RTS.
+    ghcDebugged :: Bool,
+    -- | Build GHC with debug assertions.
+    ghcDebugAssertions :: Bool,
     -- | Build the GHC executable against the threaded runtime system.
     ghcThreaded :: Bool,
     -- | Whether to build docs and which ones
diff --git a/hadrian/src/Flavour.hs b/hadrian/src/Flavour.hs
index 25416294e7..33d4d68ec4 100644
--- a/hadrian/src/Flavour.hs
+++ b/hadrian/src/Flavour.hs
@@ -213,10 +213,7 @@ enableLateCCS =
 
 -- | Enable assertions for the stage2 compiler
 enableAssertions :: Flavour -> Flavour
-enableAssertions =
-  let Right kv = parseKV "stage1.*.ghc.hs.opts += -DDEBUG"
-      Right transformer = applySetting kv
-  in transformer
+enableAssertions flav = flav { ghcDebugAssertions = True }
 
 -- | 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 9f992fd6f2..46d540aabe 100644
--- a/hadrian/src/Flavour/Type.hs
+++ b/hadrian/src/Flavour/Type.hs
@@ -32,8 +32,10 @@ data Flavour = Flavour {
     ghciWithDebugger :: Bool,
     -- | Build profiled GHC.
     ghcProfiled :: Bool,
-    -- | Build GHC with debugging assertions.
+    -- | Build GHC with the debug RTS.
     ghcDebugged :: Bool,
+    -- | Build GHC with debug assertions.
+    ghcDebugAssertions :: Bool,
     -- | Build the GHC executable against the threaded runtime system.
     ghcThreaded :: 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 6a49334a70..fcc4f1816d 100644
--- a/hadrian/src/Settings/Builders/RunTest.hs
+++ b/hadrian/src/Settings/Builders/RunTest.hs
@@ -2,6 +2,7 @@
 module Settings.Builders.RunTest (runTestBuilderArgs, runTestGhcFlags) where
 
 import Hadrian.Utilities
+import qualified System.FilePath
 import System.Environment
 
 import CommandLine
@@ -63,13 +64,16 @@ data TestCompilerArgs = TestCompilerArgs{
  ,   withInterpreter   :: Bool
  ,   unregisterised    :: Bool
  ,   withSMP           :: Bool
- ,   debugged          :: Bool
+ ,   debugAssertions   :: Bool
+      -- ^ Whether the compiler has debug assertions enabled,
+      -- corresponding to the -DDEBUG option.
  ,   profiled          :: Bool
  ,   os,arch, platform, wordsize :: String
  ,   libdir :: FilePath
  ,   have_llvm :: Bool
  ,   rtsLinker :: Bool
  ,   pkgConfCacheFile :: FilePath }
+   deriving (Eq, Show)
 
 
 -- | If the tree is in-compiler then we already know how we will build it so
@@ -95,8 +99,8 @@ inTreeCompilerArgs stg = expr $ do
     withInterpreter     <- ghcWithInterpreter
     unregisterised      <- flag GhcUnregisterised
     withSMP             <- targetSupportsSMP
-    debugged            <- ghcDebugged <$> flavour
-    profiled            <- ghcProfiled <$> flavour
+    debugAssertions     <- ghcDebugAssertions <$> flavour
+    profiled            <- ghcProfiled        <$> flavour
 
     os          <- setting HostOs
     arch        <- setting TargetArch
@@ -108,8 +112,10 @@ inTreeCompilerArgs stg = expr $ do
 
     top         <- topDirectory
 
-    pkgConfCacheFile <- (top -/-) <$> (packageDbPath stg <&> (-/- "package.cache"))
-    libdir <- (top -/-) <$> stageLibPath stg
+    pkgConfCacheFile <- System.FilePath.normalise . (top -/-)
+                    <$> (packageDbPath stg <&> (-/- "package.cache"))
+    libdir           <- System.FilePath.normalise . (top -/-)
+                    <$> stageLibPath stg
 
     rtsLinker <- (== "YES") <$> setting TargetHasRtsLinker
 
@@ -136,8 +142,7 @@ outOfTreeCompilerArgs testGhc = do
     withInterpreter     <- getBooleanSetting TestGhcWithInterpreter
     unregisterised      <- getBooleanSetting TestGhcUnregisterised
     withSMP             <- getBooleanSetting TestGhcWithSMP
-    debugged            <- getBooleanSetting TestGhcDebugged
-
+    debugAssertions     <- getBooleanSetting TestGhcDebugged
 
     os          <- getTestSetting TestHostOS
     arch        <- getTestSetting TestTargetARCH_CPP
@@ -148,8 +153,8 @@ outOfTreeCompilerArgs testGhc = do
     have_llvm <- expr (liftIO (isJust <$> findExecutable llc_cmd))
     profiled <- getBooleanSetting TestGhcProfiled
 
-    pkgConfCacheFile <- getTestSetting TestGhcPackageDb <&> (-/- "package.cache")
-    libdir <-  getTestSetting TestGhcLibDir
+    pkgConfCacheFile <- getTestSetting TestGhcPackageDb <&> (</> "package.cache")
+    libdir <- getTestSetting TestGhcLibDir
 
     rtsLinker <- getBooleanSetting TestGhcWithRtsLinker
     return TestCompilerArgs{..}
@@ -170,7 +175,14 @@ runTestBuilderArgs = builder Testsuite ? do
     TestCompilerArgs{..} <-
       case stageOfTestCompiler testGhc of
         Just stg -> inTreeCompilerArgs stg
-        Nothing -> outOfTreeCompilerArgs testGhc
+                 {- do { in_args  <- inTreeCompilerArgs stg
+                       ; out_args <- outOfTreeCompilerArgs testGhc
+                       ; when (in_args /= out_args) $ error $
+                          "in-tree arguments don't match out-of-tree arguments:\n\
+                          \in-tree arguments:\n" ++ show in_args ++ "\n\
+                          \out-of-tree arguments:\n" ++ show out_args
+                       ; return in_args } -}
+        Nothing  -> outOfTreeCompilerArgs testGhc
 
     -- MP: TODO, these should be queried from the test compiler?
     bignumBackend <- getBignumBackend
@@ -214,8 +226,8 @@ runTestBuilderArgs = builder Testsuite ? do
             , arg "-e", arg $ "config.accept_platform=" ++ show acceptPlatform
             , arg "-e", arg $ "config.accept_os=" ++ show acceptOS
             , arg "-e", arg $ "config.exeext=" ++ quote (if null exe then "" else "."<>exe)
-            , arg "-e", arg $ "config.compiler_debugged=" ++
-              show debugged
+            , arg "-e", arg $ "config.compiler_debugged=" ++ show debugAssertions
+
             -- MP: TODO, we do not need both, they get aliased to the same thing.
             , arg "-e", arg $ asBool "ghc_with_native_codegen=" withNativeCodeGen
             , arg "-e", arg $ asBool "config.have_ncg=" withNativeCodeGen
diff --git a/hadrian/src/Settings/Default.hs b/hadrian/src/Settings/Default.hs
index 21ab008cb7..441f009107 100644
--- a/hadrian/src/Settings/Default.hs
+++ b/hadrian/src/Settings/Default.hs
@@ -236,6 +236,7 @@ defaultFlavour = Flavour
     , ghciWithDebugger   = False
     , ghcProfiled        = False
     , ghcDebugged        = False
+    , ghcDebugAssertions = False
     , ghcThreaded        = True
     , ghcDocs            = cmdDocsArgs }
 
diff --git a/hadrian/src/Settings/Flavours/Development.hs b/hadrian/src/Settings/Flavours/Development.hs
index cce12b53d1..9c0a342bac 100644
--- a/hadrian/src/Settings/Flavours/Development.hs
+++ b/hadrian/src/Settings/Flavours/Development.hs
@@ -12,7 +12,8 @@ developmentFlavour ghcStage = defaultFlavour
     , args = defaultBuilderArgs <> developmentArgs ghcStage <> defaultPackageArgs
     , libraryWays = pure [vanilla]
     , rtsWays = pure [vanilla, logging, debug, threaded, threadedLogging, threadedDebug]
-    , dynamicGhcPrograms = return False }
+    , dynamicGhcPrograms = return False
+    , ghcDebugAssertions = True }
 
 developmentArgs :: Stage -> Args
 developmentArgs ghcStage = do
@@ -24,5 +25,5 @@ developmentArgs ghcStage = do
                                  package cabal ? pure ["-O0"]]
         , hsLibrary  = notStage0 ? arg "-dcore-lint"
         , hsCompiler = mconcat [stage0 ? arg "-O2",
-                                succ stage == ghcStage ? pure ["-O0", "-DDEBUG"]]
-        , hsGhc      = succ stage == ghcStage ? pure ["-O0", "-DDEBUG"] }
+                                succ stage == ghcStage ? pure ["-O0"]]
+        , hsGhc      = succ stage == ghcStage ? pure ["-O0"] }
diff --git a/hadrian/src/Settings/Flavours/Validate.hs b/hadrian/src/Settings/Flavours/Validate.hs
index 79377e83e3..7e54278f90 100644
--- a/hadrian/src/Settings/Flavours/Validate.hs
+++ b/hadrian/src/Settings/Flavours/Validate.hs
@@ -37,20 +37,10 @@ validateArgs = sourceArgs SourceArgs
 slowValidateFlavour :: Flavour
 slowValidateFlavour = werror $ validateFlavour
     { name = "slow-validate"
-    , args = defaultBuilderArgs <> slowValidateArgs <> defaultPackageArgs
+    , args = defaultBuilderArgs <> validateArgs <> defaultPackageArgs
+    , ghcDebugAssertions = True
     }
 
-slowValidateArgs :: Args
-slowValidateArgs =
-  mconcat [ validateArgs
-          , sourceArgs SourceArgs
-            { hsCompiler = notStage0 ? arg "-DDEBUG"
-            , hsDefault  = mempty
-            , hsLibrary  = mempty
-            , hsGhc      = mempty
-            }
-          ]
-
 quickValidateArgs :: Args
 quickValidateArgs = sourceArgs SourceArgs
     { hsDefault  = mempty
diff --git a/hadrian/src/Settings/Packages.hs b/hadrian/src/Settings/Packages.hs
index 33ffa91289..43141610a7 100644
--- a/hadrian/src/Settings/Packages.hs
+++ b/hadrian/src/Settings/Packages.hs
@@ -26,6 +26,7 @@ packageArgs = do
 
     cursesIncludeDir <- getSetting CursesIncludeDir
     cursesLibraryDir <- getSetting CursesLibDir
+    debugAssertions  <- ghcDebugAssertions <$> expr flavour
 
     mconcat
         --------------------------------- base ---------------------------------
@@ -48,7 +49,9 @@ packageArgs = do
           [ builder Alex ? arg "--latin1"
 
           , builder (Ghc CompileHs) ? mconcat
-            [ inputs ["**/GHC.hs", "**/GHC/Driver/Make.hs"] ? arg "-fprof-auto"
+            [ debugAssertions ? notStage0 ? arg "-DDEBUG"
+
+            , inputs ["**/GHC.hs", "**/GHC/Driver/Make.hs"] ? arg "-fprof-auto"
             , input "**/Parser.hs" ?
               pure ["-fno-ignore-interface-pragmas", "-fcmm-sink"]
             -- Enable -haddock and -Winvalid-haddock for the compiler
@@ -75,7 +78,9 @@ packageArgs = do
 
         ---------------------------------- ghc ---------------------------------
         , package ghc ? mconcat
-          [ builder Ghc ? arg ("-I" ++ compilerPath)
+          [ builder Ghc ? mconcat
+             [ arg ("-I" ++ compilerPath)
+             , debugAssertions ? notStage0 ? arg "-DDEBUG" ]
 
           , builder (Cabal Flags) ? mconcat
             [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter"