summaryrefslogtreecommitdiff
path: root/testsuite
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite')
-rw-r--r--testsuite/tests/callarity/unittest/CallArity1.hs10
-rw-r--r--testsuite/tests/count-deps/CountDepsAst.stdout3
-rw-r--r--testsuite/tests/count-deps/CountDepsParser.stdout3
-rw-r--r--testsuite/tests/ghc-api/T11579.hs2
-rw-r--r--testsuite/tests/ghc-api/T7478/T7478.hs8
-rw-r--r--testsuite/tests/ghc-api/T9015.hs2
-rw-r--r--testsuite/tests/plugins/static-plugins.hs2
-rw-r--r--testsuite/tests/regalloc/regalloc_unit_tests.hs29
8 files changed, 31 insertions, 28 deletions
diff --git a/testsuite/tests/callarity/unittest/CallArity1.hs b/testsuite/tests/callarity/unittest/CallArity1.hs
index 64800dd243..7f51426823 100644
--- a/testsuite/tests/callarity/unittest/CallArity1.hs
+++ b/testsuite/tests/callarity/unittest/CallArity1.hs
@@ -173,16 +173,16 @@ main = do
logger <- getLogger
liftIO $ forM_ exprs $ \(n,e) -> do
case lintExpr dflags [f,scrutf,scruta] e of
- Just errs -> putMsg logger dflags (pprMessageBag errs $$ text "in" <+> text n)
+ Just errs -> putMsg logger (pprMessageBag errs $$ text "in" <+> text n)
Nothing -> return ()
- putMsg logger dflags (text n Outputable.<> char ':')
- -- liftIO $ putMsg dflags (ppr e)
+ putMsg logger (text n Outputable.<> char ':')
+ -- liftIO $ putMsg logger (ppr e)
let e' = callArityRHS e
let bndrs = nonDetEltsUniqSet (allBoundIds e')
-- It should be OK to use nonDetEltsUniqSet here, if it becomes a
-- problem we should use DVarSet
- -- liftIO $ putMsg dflags (ppr e')
- forM_ bndrs $ \v -> putMsg logger dflags $ nest 4 $ ppr v <+> ppr (idCallArity v)
+ -- liftIO $ putMsg logger (ppr e')
+ forM_ bndrs $ \v -> putMsg logger $ nest 4 $ ppr v <+> ppr (idCallArity v)
-- Utilities
mkLApps :: Id -> [Integer] -> CoreExpr
diff --git a/testsuite/tests/count-deps/CountDepsAst.stdout b/testsuite/tests/count-deps/CountDepsAst.stdout
index 4b33ad2982..8411e66318 100644
--- a/testsuite/tests/count-deps/CountDepsAst.stdout
+++ b/testsuite/tests/count-deps/CountDepsAst.stdout
@@ -1,4 +1,4 @@
-Found 266 Language.Haskell.Syntax module dependencies
+Found 267 Language.Haskell.Syntax module dependencies
GHC.Builtin.Names
GHC.Builtin.PrimOps
GHC.Builtin.Types
@@ -82,6 +82,7 @@ GHC.Data.StringBuffer
GHC.Data.TrieMap
GHC.Driver.Backend
GHC.Driver.CmdLine
+GHC.Driver.Config.Logger
GHC.Driver.Env
GHC.Driver.Env.Types
GHC.Driver.Errors
diff --git a/testsuite/tests/count-deps/CountDepsParser.stdout b/testsuite/tests/count-deps/CountDepsParser.stdout
index 16dbb8e185..d6878d6bd5 100644
--- a/testsuite/tests/count-deps/CountDepsParser.stdout
+++ b/testsuite/tests/count-deps/CountDepsParser.stdout
@@ -1,4 +1,4 @@
-Found 272 GHC.Parser module dependencies
+Found 273 GHC.Parser module dependencies
GHC.Builtin.Names
GHC.Builtin.PrimOps
GHC.Builtin.Types
@@ -83,6 +83,7 @@ GHC.Data.TrieMap
GHC.Driver.Backend
GHC.Driver.Backpack.Syntax
GHC.Driver.CmdLine
+GHC.Driver.Config.Logger
GHC.Driver.Env
GHC.Driver.Env.Types
GHC.Driver.Errors
diff --git a/testsuite/tests/ghc-api/T11579.hs b/testsuite/tests/ghc-api/T11579.hs
index f2beeb3035..fc8c2c5fff 100644
--- a/testsuite/tests/ghc-api/T11579.hs
+++ b/testsuite/tests/ghc-api/T11579.hs
@@ -1,6 +1,6 @@
import System.Environment
import GHC.Driver.Session
-import GHC.Driver.Config
+import GHC.Driver.Config.Parser (initParserOpts)
import GHC.Data.FastString
import GHC
import GHC.Data.StringBuffer
diff --git a/testsuite/tests/ghc-api/T7478/T7478.hs b/testsuite/tests/ghc-api/T7478/T7478.hs
index dbea3f9547..b31a5688a6 100644
--- a/testsuite/tests/ghc-api/T7478/T7478.hs
+++ b/testsuite/tests/ghc-api/T7478/T7478.hs
@@ -24,6 +24,10 @@ compileInGhc targets handlerOutput = do
flags0 <- getSessionDynFlags
let flags = flags0 {verbosity = 1 }
setSessionDynFlags flags
+ let collectSrcError handlerOutput _flags MCOutput _srcspan msg
+ = handlerOutput $ GHC.showSDocForUser flags emptyUnitState alwaysQualify msg
+ collectSrcError _ _ _ _ _
+ = return ()
pushLogHookM (const (collectSrcError handlerOutput))
-- Set up targets.
oldTargets <- getTargets
@@ -48,10 +52,6 @@ compileInGhc targets handlerOutput = do
TargetFile file Nothing -> file
_ -> error "fileFromTarget: not a known target"
- collectSrcError handlerOutput flags MCOutput _srcspan msg
- = handlerOutput $ GHC.showSDocForUser flags emptyUnitState alwaysQualify msg
- collectSrcError _ _ _ _ _
- = return ()
main :: IO ()
main = do
diff --git a/testsuite/tests/ghc-api/T9015.hs b/testsuite/tests/ghc-api/T9015.hs
index 3ca05afc7d..b97ec34a60 100644
--- a/testsuite/tests/ghc-api/T9015.hs
+++ b/testsuite/tests/ghc-api/T9015.hs
@@ -3,7 +3,7 @@ module Main where
import GHC
import GHC.Driver.Session
import GHC.Driver.Monad
-import GHC.Driver.Config
+import GHC.Driver.Config.Parser (initParserOpts)
import System.Environment
testStrings = [
diff --git a/testsuite/tests/plugins/static-plugins.hs b/testsuite/tests/plugins/static-plugins.hs
index b263c01b1d..73d91a93e3 100644
--- a/testsuite/tests/plugins/static-plugins.hs
+++ b/testsuite/tests/plugins/static-plugins.hs
@@ -2,7 +2,7 @@ module Main where
import GHC.Driver.Env
import GHC.Driver.Session
- (getDynFlags, parseDynamicFlagsCmdLine, defaultFatalMessager, defaultFlushOut)
+ (extractDynFlags, parseDynamicFlagsCmdLine, defaultFatalMessager, defaultFlushOut)
import GHC.Driver.Plugins
import GHC.Driver.Monad
diff --git a/testsuite/tests/regalloc/regalloc_unit_tests.hs b/testsuite/tests/regalloc/regalloc_unit_tests.hs
index f68cd040df..419a723062 100644
--- a/testsuite/tests/regalloc/regalloc_unit_tests.hs
+++ b/testsuite/tests/regalloc/regalloc_unit_tests.hs
@@ -24,6 +24,7 @@ import qualified GHC.CmmToAsm.Reg.Graph.Stats as Color
import qualified GHC.CmmToAsm.Reg.Linear.Base as Linear
import qualified GHC.CmmToAsm.X86.Instr as X86.Instr
import qualified GHC.CmmToAsm.X86 as X86
+import GHC.Driver.Config.CmmToAsm
import GHC.Driver.Main
import GHC.Driver.Env
import GHC.StgToCmm.CgUtils
@@ -44,6 +45,7 @@ import GHC.Types.Unique.Supply
import GHC.Driver.Session
import GHC.Driver.Errors
import GHC.Utils.Error
+import GHC.Utils.Logger
import GHC.Utils.Outputable
import GHC.Types.Basic
import GHC.Unit.Home
@@ -64,8 +66,15 @@ main = do
--get a GHC context and run the tests
runGhc (Just libdir) $ do
- dflags0 <- fmap setOptions getDynFlags
- setSessionDynFlags dflags0
+ dflags0 <- flip gopt_set Opt_RegsGraph <$> getDynFlags
+ --the register allocator's intermediate data
+ --structures are usually discarded
+ --(in GHC.CmmToAsm.cmmNativeGen) for performance
+ --reasons. To prevent this we need to tell
+ --cmmNativeGen we want them printed out even
+ --though we ignore stderr in the test configuration.
+ let dflags1 = dopt_set dflags0 Opt_D_dump_asm_stats
+ setSessionDynFlags dflags1
dflags <- getDynFlags
logger <- getLogger
@@ -75,8 +84,6 @@ main = do
return ()
- where setOptions = (flip gopt_set) Opt_RegsGraph
-
-- | TODO: Make this an IORef along the lines of Data.Unique.newUnique to add
-- stronger guarantees a UniqSupply won't be accidentally reused
@@ -113,7 +120,7 @@ compileCmmForRegAllocStats ::
UniqSupply ->
IO [( Maybe [Color.RegAllocStats (Alignment, RawCmmStatics) X86.Instr.Instr]
, Maybe [Linear.RegAllocStats])]
-compileCmmForRegAllocStats logger dflags' cmmFile ncgImplF us = do
+compileCmmForRegAllocStats logger dflags cmmFile ncgImplF us = do
let ncgImpl = ncgImplF (initNCGConfig dflags thisMod)
hscEnv <- newHscEnv dflags
@@ -127,13 +134,14 @@ compileCmmForRegAllocStats logger dflags' cmmFile ncgImplF us = do
let initTopSRT = emptySRT thisMod
cmmGroup <- fmap snd $ cmmPipeline hscEnv initTopSRT $ fst $ fromJust parsedCmm
- rawCmms <- cmmToRawCmm logger dflags (Stream.yield cmmGroup)
+ let profile = targetProfile dflags
+ rawCmms <- cmmToRawCmm logger profile (Stream.yield cmmGroup)
collectedCmms <- mconcat <$> Stream.collect rawCmms
-- compile and discard the generated code, returning regalloc stats
mapM (\ (count, thisCmm) ->
- cmmNativeGen logger dflags thisModLoc ncgImpl
+ cmmNativeGen logger thisModLoc ncgImpl
usb dwarfFileIds dbgMap thisCmm count >>=
(\(_, _, _, _, colorStats, linearStats, _) ->
-- scrub unneeded output from cmmNativeGen
@@ -141,13 +149,6 @@ compileCmmForRegAllocStats logger dflags' cmmFile ncgImplF us = do
$ zip [0.. (length collectedCmms)] collectedCmms
where
- --the register allocator's intermediate data
- --structures are usually discarded
- --(in AsmCodeGen.cmmNativeGen) for performance
- --reasons. To prevent this we need to tell
- --cmmNativeGen we want them printed out even
- --though we ignore stderr in the test configuration.
- dflags = dopt_set dflags' Opt_D_dump_asm_stats
[usa, usb, usc, usd] = take 4 . listSplitUniqSupply $ us
-- don't need debugging information
dwarfFileIds = emptyUFM
View Lorry Controller Status