[Git][ghc/ghc][master] 2 commits: Refine in-tree compiler args for --test-compiler=stage1

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
e8eaf807 by Matthew Pickering at 2022-08-31T18:27:57-04:00
Refine in-tree compiler args for --test-compiler=stage1

Some of the logic to calculate in-tree arguments was not correct for the
stage1 compiler. Namely we were not correctly reporting whether we were
building static or dynamic executables and whether debug assertions were
enabled.

Fixes #22096

- - - - -
6b2f7ffe by Matthew Pickering at 2022-08-31T18:27:57-04:00
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 changed files:

- hadrian/src/Flavour.hs
- hadrian/src/Flavour/Type.hs
- hadrian/src/Settings/Builders/RunTest.hs
- hadrian/src/Settings/Default.hs
- hadrian/src/Settings/Flavours/Development.hs
- hadrian/src/Settings/Flavours/Validate.hs
- hadrian/src/Settings/Packages.hs


Changes:

=====================================
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.


=====================================
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


=====================================
hadrian/src/Settings/Builders/RunTest.hs
=====================================
@@ -17,6 +17,8 @@ import qualified Data.Set    as Set
 import Flavour
 import qualified Context.Type as C
 import System.Directory (findExecutable)
+import Settings.Program
+import qualified Context.Type
 
 getTestSetting :: TestSetting -> Action String
 getTestSetting key = testSetting key
@@ -91,16 +93,14 @@ inTreeCompilerArgs stg = do
       return (dynamic `elem` ways, threaded `elem` ways)
     -- MP: We should be able to vary if stage1/stage2 is dynamic, ie a dynamic stage1
     -- should be able to built a static stage2?
-    hasDynamic          <- flavour >>= dynamicGhcPrograms
+    hasDynamic          <- (dynamic ==) . Context.Type.way <$> (programContext stg ghc)
     -- LeadingUnderscore is a property of the system so if cross-compiling stage1/stage2 could
     -- have different values? Currently not possible to express.
     leadingUnderscore   <- flag LeadingUnderscore
-    -- MP: This setting seems to only dictate whether we turn on optasm as a compiler
-    -- way, but a lot of tests which use only_ways(optasm) seem to not test the NCG?
     withInterpreter     <- ghcWithInterpreter
     unregisterised      <- flag GhcUnregisterised
     withSMP             <- targetSupportsSMP
-    debugAssertions     <- ghcDebugAssertions <$> flavour
+    debugAssertions     <- ($ stg) . ghcDebugAssertions <$> flavour
     profiled            <- ghcProfiled        <$> flavour <*> pure stg
 
     os          <- setting HostOs


=====================================
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


=====================================
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"


=====================================
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


=====================================
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"



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f7b4dcbd7d76101e7e6eee728bde2b5a5c873c02...6b2f7ffea51304091bfa4bd1d88a58ea373ee551

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f7b4dcbd7d76101e7e6eee728bde2b5a5c873c02...6b2f7ffea51304091bfa4bd1d88a58ea373ee551
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20220831/55aeb130/attachment-0001.html>