[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: testsuite: Mark T16392 as fragile on windows
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Dec 20 19:04:45 UTC 2022
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
5e047eff by Matthew Pickering at 2022-12-20T15:12:04+00:00
testsuite: Mark T16392 as fragile on windows
See #22649
- - - - -
269dcffb by M Farkas-Dyck at 2022-12-20T14:04:27-05:00
Scrub some partiality in `GHC.Cmm.Info.Build`: `doSRTs` takes a `[(CAFSet, CmmDecl)]` but truly wants a `[(CAFSet, CmmStatics)]`.
- - - - -
83d06f07 by Matthew Pickering at 2022-12-20T14:04:29-05:00
packaging: Fix upload_ghc_libs.py script
This change reflects the changes where .cabal files are now generated by
hadrian rather than ./configure.
Fixes #22518
- - - - -
36255542 by Ben Gamari at 2022-12-20T14:04:30-05:00
configure: Drop uses of AC_PROG_CC_C99
As noted in #22566, this macro is deprecated as of autoconf-2.70
`AC_PROG_CC` now sets `ac_cv_prog_cc_c99` itself.
Closes #22566.
- - - - -
31fd2153 by Ben Gamari at 2022-12-20T14:04:30-05:00
configure: Use AS_HELP_STRING instead of AC_HELP_STRING
The latter has been deprecated.
See #22566.
- - - - -
d50387b2 by Bodigrim at 2022-12-20T14:04:31-05:00
GHCi.UI: fix various usages of head and tail
- - - - -
b8f83b4e by Bodigrim at 2022-12-20T14:04:31-05:00
GHCi.UI: avoid head and tail in parseCallEscape and around
- - - - -
8965610f by Bodigrim at 2022-12-20T14:04:31-05:00
Make GHC.Driver.Main.hscTcRnLookupRdrName to return NonEmpty
- - - - -
13 changed files:
- .gitlab/upload_ghc_libs.py
- compiler/GHC/Cmm.hs
- compiler/GHC/Cmm/Info/Build.hs
- compiler/GHC/Cmm/Pipeline.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Runtime/Debugger.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Utils/Outputable.hs
- configure.ac
- distrib/configure.ac.in
- ghc/GHCi/UI.hs
- − m4/fp_set_cflags_c99.m4
- testsuite/tests/ghci/T16392/all.T
Changes:
=====================================
.gitlab/upload_ghc_libs.py
=====================================
@@ -51,15 +51,19 @@ def prep_base():
def build_copy_file(pkg: Package, f: Path):
target = Path('_build') / 'stage1' / pkg.path / 'build' / f
dest = pkg.path / f
- print(f'Building {target} for {dest}...')
+ build_file_hadrian(target)
+ print(f'Copying {target} to {dest}...')
+ dest.parent.mkdir(exist_ok=True, parents=True)
+ shutil.copyfile(target, dest)
+
+def build_file_hadrian(target: Path):
build_cabal = Path('hadrian') / 'build-cabal'
if not build_cabal.is_file():
build_cabal = Path('hadrian') / 'build.cabal.sh'
+ print(f'Building {target}...')
run([build_cabal, target], check=True)
- dest.parent.mkdir(exist_ok=True, parents=True)
- shutil.copyfile(target, dest)
def modify_file(pkg: Package, fname: Path, f: Callable[[str], str]):
target = pkg.path / fname
@@ -116,6 +120,7 @@ def prepare_sdist(pkg: Package):
print(f'Preparing package {pkg.name}...')
shutil.rmtree(pkg.path / 'dist-newstyle', ignore_errors=True)
+ build_file_hadrian(pkg.path / '{}.cabal'.format(pkg.name))
pkg.prepare_sdist()
# Upload source tarball
=====================================
compiler/GHC/Cmm.hs
=====================================
@@ -7,11 +7,14 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE EmptyCase #-}
module GHC.Cmm (
-- * Cmm top-level datatypes
CmmProgram, CmmGroup, CmmGroupSRTs, RawCmmGroup, GenCmmGroup,
CmmDecl, CmmDeclSRTs, GenCmmDecl(..),
+ CmmDataDecl, cmmDataDeclCmmDecl,
CmmGraph, GenCmmGraph(..),
toBlockMap, revPostorder, toBlockList,
CmmBlock, RawCmmDecl,
@@ -52,6 +55,7 @@ import GHC.Cmm.Dataflow.Graph
import GHC.Cmm.Dataflow.Label
import GHC.Utils.Outputable
+import Data.Void (Void)
import Data.List (intersperse)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
@@ -116,6 +120,14 @@ instance (OutputableP Platform d, OutputableP Platform info, OutputableP Platfor
type CmmDecl = GenCmmDecl CmmStatics CmmTopInfo CmmGraph
type CmmDeclSRTs = GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
+type CmmDataDecl = GenCmmDataDecl CmmStatics
+type GenCmmDataDecl d = GenCmmDecl d Void Void -- When `CmmProc` case can be statically excluded
+
+cmmDataDeclCmmDecl :: GenCmmDataDecl d -> GenCmmDecl d h g
+cmmDataDeclCmmDecl = \ case
+ CmmProc void _ _ _ -> case void of
+ CmmData section d -> CmmData section d
+{-# INLINE cmmDataDeclCmmDecl #-}
type RawCmmDecl
= GenCmmDecl
=====================================
compiler/GHC/Cmm/Info/Build.hs
=====================================
@@ -1,6 +1,6 @@
{-# LANGUAGE GADTs, BangPatterns, RecordWildCards,
GeneralizedNewtypeDeriving, NondecreasingIndentation, TupleSections,
- ScopedTypeVariables, OverloadedStrings, LambdaCase #-}
+ ScopedTypeVariables, OverloadedStrings, LambdaCase, EmptyCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
@@ -884,7 +884,7 @@ doSRTs
:: CmmConfig
-> ModuleSRTInfo
-> [(CAFEnv, [CmmDecl])] -- ^ 'CAFEnv's and 'CmmDecl's for code blocks
- -> [(CAFSet, CmmDecl)] -- ^ static data decls and their 'CAFSet's
+ -> [(CAFSet, CmmDataDecl)] -- ^ static data decls and their 'CAFSet's
-> IO (ModuleSRTInfo, [CmmDeclSRTs])
doSRTs cfg moduleSRTInfo procs data_ = do
@@ -900,8 +900,7 @@ doSRTs cfg moduleSRTInfo procs data_ = do
flip map data_ $
\(set, decl) ->
case decl of
- CmmProc{} ->
- pprPanic "doSRTs" (text "Proc in static data list:" <+> pdoc platform decl)
+ CmmProc void _ _ _ -> case void of
CmmData _ static ->
case static of
CmmStatics lbl _ _ _ _ -> (lbl, set)
@@ -909,7 +908,7 @@ doSRTs cfg moduleSRTInfo procs data_ = do
(proc_envs, procss) = unzip procs
cafEnv = mapUnions proc_envs
- decls = map snd data_ ++ concat procss
+ decls = map (cmmDataDeclCmmDecl . snd) data_ ++ concat procss
staticFuns = mapFromList (getStaticFuns decls)
platform = cmmPlatform cfg
@@ -980,8 +979,7 @@ doSRTs cfg moduleSRTInfo procs data_ = do
| otherwise ->
-- Not an IdLabel, ignore
srtMap
- CmmProc{} ->
- pprPanic "doSRTs" (text "Found Proc in static data list:" <+> pdoc platform decl))
+ CmmProc void _ _ _ -> case void of)
(moduleSRTMap moduleSRTInfo') data_
return (moduleSRTInfo'{ moduleSRTMap = srtMap_w_raws }, srt_decls ++ decls')
=====================================
compiler/GHC/Cmm/Pipeline.hs
=====================================
@@ -67,8 +67,8 @@ cmmPipeline logger cmm_config srtInfo prog = do
-- [SRTs].
--
-- - in the case of a `CmmData`, the unmodified 'CmmDecl' and a 'CAFSet' containing
-cpsTop :: Logger -> Platform -> CmmConfig -> CmmDecl -> IO (Either (CAFEnv, [CmmDecl]) (CAFSet, CmmDecl))
-cpsTop _logger platform _ p@(CmmData _ statics) = return (Right (cafAnalData platform statics, p))
+cpsTop :: Logger -> Platform -> CmmConfig -> CmmDecl -> IO (Either (CAFEnv, [CmmDecl]) (CAFSet, CmmDataDecl))
+cpsTop _logger platform _ (CmmData section statics) = return (Right (cafAnalData platform statics, CmmData section statics))
cpsTop logger platform cfg proc =
do
----------- Control-flow optimisations ----------------------------------
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -266,6 +266,7 @@ import GHC.SysTools.BaseDir (findTopDir)
import Data.Data hiding (Fixity, TyCon)
import Data.List ( nub, isPrefixOf, partition )
+import qualified Data.List.NonEmpty as NE
import Control.Monad
import Data.IORef
import System.FilePath as FilePath
@@ -445,11 +446,15 @@ ioMsgMaybe' ioA = do
-- -----------------------------------------------------------------------------
-- | Lookup things in the compiler's environment
-hscTcRnLookupRdrName :: HscEnv -> LocatedN RdrName -> IO [Name]
+hscTcRnLookupRdrName :: HscEnv -> LocatedN RdrName -> IO (NonEmpty Name)
hscTcRnLookupRdrName hsc_env0 rdr_name
= runInteractiveHsc hsc_env0 $
do { hsc_env <- getHscEnv
- ; ioMsgMaybe $ hoistTcRnMessage $ tcRnLookupRdrName hsc_env rdr_name }
+ -- tcRnLookupRdrName can return empty list only together with TcRnUnknownMessage.
+ -- Once errors has been dealt with in hoistTcRnMessage, we can enforce
+ -- this invariant in types by converting to NonEmpty.
+ ; ioMsgMaybe $ fmap (fmap (>>= NE.nonEmpty)) $ hoistTcRnMessage $
+ tcRnLookupRdrName hsc_env rdr_name }
hscTcRcLookupName :: HscEnv -> Name -> IO (Maybe TyThing)
hscTcRcLookupName hsc_env0 name = runInteractiveHsc hsc_env0 $ do
=====================================
compiler/GHC/Runtime/Debugger.hs
=====================================
@@ -49,6 +49,7 @@ import GHC.Types.TyThing
import Control.Monad
import Control.Monad.Catch as MC
import Data.List ( (\\), partition )
+import qualified Data.List.NonEmpty as NE
import Data.Maybe
import Data.IORef
@@ -57,7 +58,7 @@ import Data.IORef
-------------------------------------
pprintClosureCommand :: GhcMonad m => Bool -> Bool -> String -> m ()
pprintClosureCommand bindThings force str = do
- tythings <- (catMaybes . concat) `liftM`
+ tythings <- (catMaybes . concatMap NE.toList) `liftM`
mapM (\w -> GHC.parseName w >>=
mapM GHC.lookupName)
(words str)
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -121,6 +121,7 @@ import Data.Either
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.List (find,intercalate)
+import Data.List.NonEmpty (NonEmpty)
import Control.Monad
import Control.Monad.Catch as MC
import Data.Array
@@ -903,7 +904,7 @@ getRdrNamesInScope = withSession $ \hsc_env -> do
-- | Parses a string as an identifier, and returns the list of 'Name's that
-- the identifier can refer to in the current interactive context.
-parseName :: GhcMonad m => String -> m [Name]
+parseName :: GhcMonad m => String -> m (NonEmpty Name)
parseName str = withSession $ \hsc_env -> liftIO $
do { lrdr_name <- hscParseIdentifier hsc_env str
; hscTcRnLookupRdrName hsc_env lrdr_name }
=====================================
compiler/GHC/Utils/Outputable.hs
=====================================
@@ -1,3 +1,4 @@
+{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE StandaloneDeriving #-}
@@ -151,6 +152,7 @@ import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NEL
import Data.Time
import Data.Time.Format.ISO8601
+import Data.Void
import GHC.Fingerprint
import GHC.Show ( showMultiLineString )
@@ -1173,6 +1175,8 @@ instance OutputableP env SDoc where
instance (OutputableP env a) => OutputableP env (Set a) where
pdoc env s = braces (fsep (punctuate comma (map (pdoc env) (Set.toList s))))
+instance OutputableP env Void where
+ pdoc _ = \ case
{-
************************************************************************
=====================================
configure.ac
=====================================
@@ -143,7 +143,7 @@ if test "$EnableDistroToolchain" = "YES"; then
fi
AC_ARG_ENABLE(asserts-all-ways,
-[AC_HELP_STRING([--enable-asserts-all-ways],
+[AS_HELP_STRING([--enable-asserts-all-ways],
[Usually ASSERTs are only compiled in the DEBUG way,
this will enable them in all ways.])],
[FP_CAPITALIZE_YES_NO(["$enableval"], [EnableAssertsAllWays])],
@@ -485,11 +485,6 @@ FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs)
AC_SUBST([HaskellCPPCmd])
AC_SUBST([HaskellCPPArgs])
-FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS])
-FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0])
-FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1])
-FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2])
-
dnl ** Which ld to use
dnl --------------------------------------------------------------
AC_ARG_VAR(LD,[Use as the path to ld. See also --disable-ld-override.])
=====================================
distrib/configure.ac.in
=====================================
@@ -111,11 +111,6 @@ FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs)
AC_SUBST([HaskellCPPCmd])
AC_SUBST([HaskellCPPArgs])
-FP_SET_CFLAGS_C99([CC],[CFLAGS],[CPPFLAGS])
-dnl FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0])
-FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1])
-FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2])
-
dnl ** Which ld to use?
dnl --------------------------------------------------------------
FIND_LD([$target],[GccUseLdOpt])
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -122,7 +122,7 @@ import qualified Data.ByteString.Char8 as BS
import Data.Char
import Data.Function
import Data.IORef ( IORef, modifyIORef, newIORef, readIORef, writeIORef )
-import Data.List ( elemIndices, find, intercalate, intersperse,
+import Data.List ( elemIndices, find, intercalate, intersperse, minimumBy,
isPrefixOf, isSuffixOf, nub, partition, sort, sortBy, (\\) )
import qualified Data.List.NonEmpty as NE
import qualified Data.Set as S
@@ -941,23 +941,26 @@ getInfoForPrompt = do
return (dots <> context_bit, modules_names, line)
-parseCallEscape :: String -> (String, String)
-parseCallEscape s
- | not (all isSpace beforeOpen) = ("", "")
- | null sinceOpen = ("", "")
- | null sinceClosed = ("", "")
- | null cmd = ("", "")
- | otherwise = (cmd, tail sinceClosed)
- where
- (beforeOpen, sinceOpen) = span (/='(') s
- (cmd, sinceClosed) = span (/=')') (tail sinceOpen)
+-- | Takes a string, presumably following "%call", and tries to parse
+-- a command and arguments in parentheses:
+--
+-- > parseCallEscape " (cmd arg1 arg2)rest" = Just ("cmd" :| ["arg1", "arg2"], "rest")
+-- > parseCallEscape "( )rest" = Nothing
+--
+parseCallEscape :: String -> Maybe (NE.NonEmpty String, String)
+parseCallEscape s = case dropWhile isSpace s of
+ '(' : sinceOpen -> case span (/= ')') sinceOpen of
+ (call, ')' : sinceClosed)
+ | cmd : args <- words call -> Just (cmd NE.:| args, sinceClosed)
+ _ -> Nothing
+ _ -> Nothing
checkPromptStringForErrors :: String -> Maybe String
checkPromptStringForErrors ('%':'c':'a':'l':'l':xs) =
case parseCallEscape xs of
- ("", "") -> Just ("Incorrect %call syntax. " ++
+ Nothing -> Just ("Incorrect %call syntax. " ++
"Should be %call(a command and arguments).")
- (_, afterClosed) -> checkPromptStringForErrors afterClosed
+ Just (_, afterClosed) -> checkPromptStringForErrors afterClosed
checkPromptStringForErrors ('%':'%':xs) = checkPromptStringForErrors xs
checkPromptStringForErrors (_:xs) = checkPromptStringForErrors xs
checkPromptStringForErrors "" = Nothing
@@ -1010,10 +1013,12 @@ generatePromptFunctionFromString promptS modules_names line =
processString ('%':'V':xs) =
liftM ((text $ showVersion compilerVersion) <>) (processString xs)
processString ('%':'c':'a':'l':'l':xs) = do
+ -- Input has just been validated by parseCallEscape
+ let (cmd NE.:| args, afterClosed) = fromJust $ parseCallEscape xs
respond <- liftIO $ do
(code, out, err) <-
readProcessWithExitCode
- (head list_words) (tail list_words) ""
+ cmd args ""
`catchIO` \e -> return (ExitFailure 1, "", show e)
case code of
ExitSuccess -> return out
@@ -1021,9 +1026,6 @@ generatePromptFunctionFromString promptS modules_names line =
hPutStrLn stderr err
return ""
liftM ((text respond) <>) (processString afterClosed)
- where
- (cmd, afterClosed) = parseCallEscape xs
- list_words = words cmd
processString ('%':'%':xs) =
liftM ((char '%') <>) (processString xs)
processString (x:xs) =
@@ -1055,10 +1057,7 @@ installInteractivePrint :: GhciMonad m => Maybe String -> Bool -> m ()
installInteractivePrint Nothing _ = return ()
installInteractivePrint (Just ipFun) exprmode = do
ok <- trySuccess $ do
- names <- GHC.parseName ipFun
- let name = case names of
- name':_ -> name'
- [] -> panic "installInteractivePrint"
+ name NE.:| _ <- GHC.parseName ipFun
modifySession (\he -> let new_ic = setInteractivePrintName (hsc_IC he) name
in he{hsc_IC = new_ic})
return Succeeded
@@ -1374,12 +1373,13 @@ afterRunStmt step_here run_result = do
show_types <- isOptionSet ShowType
when show_types $ printTypeOfNames names
GHC.ExecBreak names mb_info
- | isNothing mb_info ||
- step_here (GHC.resumeSpan $ head resumes) -> do
+ | first_resume : _ <- resumes
+ , isNothing mb_info ||
+ step_here (GHC.resumeSpan first_resume) -> do
mb_id_loc <- toBreakIdAndLocation mb_info
let bCmd = maybe "" ( \(_,l) -> onBreakCmd l ) mb_id_loc
if (null bCmd)
- then printStoppedAtBreakInfo (head resumes) names
+ then printStoppedAtBreakInfo first_resume names
else enqueueCommands [bCmd]
-- run the command set with ":set stop <cmd>"
st <- getGHCiState
@@ -1596,7 +1596,7 @@ infoThing allInfo str = do
names <- GHC.parseName str
mb_stuffs <- mapM (GHC.getInfo allInfo) names
let filtered = filterOutChildren (\(t,_f,_ci,_fi,_sd) -> t)
- (catMaybes mb_stuffs)
+ (catMaybes (NE.toList mb_stuffs))
return $ vcat (intersperse (text "") $ map pprInfo filtered)
-- Filter out names whose parent is also there. Good
@@ -1917,7 +1917,7 @@ docCmd s = do
docs <- traverse (buildDocComponents s) names
- let sdocs = pprDocs docs
+ let sdocs = pprDocs (NE.toList docs)
sdocs' = vcat (intersperse (text "") sdocs)
sdoc <- showSDocForUser' sdocs'
liftIO (putStrLn sdoc)
@@ -2607,15 +2607,14 @@ guessCurrentModule :: GHC.GhcMonad m => String -> m Module
-- Guess which module the user wants to browse. Pick
-- modules that are interpreted first. The most
-- recently-added module occurs last, it seems.
-guessCurrentModule cmd
- = do imports <- GHC.getContext
- when (null imports) $ throwGhcException $
- CmdLineError (':' : cmd ++ ": no current module")
- case (head imports) of
- IIModule m -> GHC.findQualifiedModule NoPkgQual m
- IIDecl d -> do
- pkgqual <- GHC.renameRawPkgQualM (unLoc $ ideclName d) (ideclPkgQual d)
- GHC.findQualifiedModule pkgqual (unLoc (ideclName d))
+guessCurrentModule cmd = do
+ imports <- GHC.getContext
+ case imports of
+ [] -> throwGhcException $ CmdLineError (':' : cmd ++ ": no current module")
+ IIModule m : _ -> GHC.findQualifiedModule NoPkgQual m
+ IIDecl d : _ -> do
+ pkgqual <- GHC.renameRawPkgQualM (unLoc $ ideclName d) (ideclPkgQual d)
+ GHC.findQualifiedModule pkgqual (unLoc (ideclName d))
-- without bang, show items in context of their parents and omit children
-- with bang, show class methods and data constructors separately, and
@@ -3507,18 +3506,15 @@ completeCmd argLine0 = case parseLine argLine0 of
liftIO $ print r
_ -> throwGhcException (CmdLineError "Syntax: :complete repl [<range>] <quoted-string-to-complete>")
where
- parseLine argLine
- | null argLine = Nothing
- | null rest1 = Nothing
- | otherwise = (,,) dom <$> resRange <*> s
- where
- (dom, rest1) = breakSpace argLine
- (rng, rest2) = breakSpace rest1
- resRange | head rest1 == '"' = parseRange ""
- | otherwise = parseRange rng
- s | head rest1 == '"' = readMaybe rest1 :: Maybe String
- | otherwise = readMaybe rest2
- breakSpace = fmap (dropWhile isSpace) . break isSpace
+ parseLine [] = Nothing
+ parseLine argLine = case breakSpace argLine of
+ (_, []) -> Nothing
+ (dom, rest1@('"' : _)) -> (dom,,) <$> parseRange "" <*> (readMaybe rest1 :: Maybe String)
+ (dom, rest1) -> (dom,,) <$> parseRange rng <*> readMaybe rest2
+ where
+ (rng, rest2) = breakSpace rest1
+
+ breakSpace = fmap (dropWhile isSpace) . break isSpace
takeRange (lb,ub) = maybe id (drop . pred) lb . maybe id take ub
@@ -3658,7 +3654,7 @@ completeBreakpoint = wrapCompleter spaces $ \w -> do -- #3000
createInscope :: GhciMonad m => String -> m [(String, Module)]
createInscope str_rdr = do
names <- GHC.parseName str_rdr
- pure $ zip (repeat str_rdr) $ GHC.nameModule <$> names
+ pure $ map (str_rdr, ) $ NE.toList $ GHC.nameModule <$> names
-- For every top-level identifier in scope, add the bids of the nested
-- declarations. See Note [Field modBreaks_decls] in GHC.ByteCode.Types
@@ -3666,7 +3662,7 @@ completeBreakpoint = wrapCompleter spaces $ \w -> do -- #3000
addNestedDecls (ident, mod) = do
(_, decls) <- getModBreak mod
let (mod_str, topLvl, _) = splitIdent ident
- ident_decls = filter ((topLvl ==) . head) $ elems decls
+ ident_decls = [ elm | elm@(el : _) <- elems decls, el == topLvl ]
bids = nub $ declPath <$> ident_decls
pure $ map (combineModIdent mod_str) bids
@@ -3843,7 +3839,7 @@ enclosingTickSpan md (RealSrcSpan src _) = do
massert (inRange (bounds ticks) line)
let enclosing_spans = [ pan | (_,pan) <- ticks ! line
, realSrcSpanEnd pan >= realSrcSpanEnd src]
- return . head . sortBy leftmostLargestRealSrcSpan $ enclosing_spans
+ return . minimumBy leftmostLargestRealSrcSpan $ enclosing_spans
where
leftmostLargestRealSrcSpan :: RealSrcSpan -> RealSrcSpan -> Ordering
@@ -4110,9 +4106,7 @@ breakById inp = do
lookupModuleInscope :: GhciMonad m => String -> m (Maybe Module)
lookupModuleInscope mod_top_lvl = do
names <- GHC.parseName mod_top_lvl
- pure $ Just $ head $ GHC.nameModule <$> names
- -- if GHC.parseName succeeds `names` is not empty!
- -- if it fails, the last line will not be evaluated.
+ pure $ Just $ NE.head $ GHC.nameModule <$> names
-- Lookup the Module of a module name in the module graph
lookupModuleInGraph :: GhciMonad m => String -> m (Maybe Module)
@@ -4645,20 +4639,17 @@ wantNameFromInterpretedModule :: GHC.GhcMonad m
-> m ()
wantNameFromInterpretedModule noCanDo str and_then =
handleSourceError GHC.printException $ do
- names <- GHC.parseName str
- case names of
- [] -> return ()
- (n:_) -> do
- let modl = assert (isExternalName n) $ GHC.nameModule n
- if not (GHC.isExternalName n)
- then noCanDo n $ ppr n <>
- text " is not defined in an interpreted module"
- else do
- is_interpreted <- GHC.moduleIsInterpreted modl
- if not is_interpreted
- then noCanDo n $ text "module " <> ppr modl <>
- text " is not interpreted"
- else and_then n
+ n NE.:| _ <- GHC.parseName str
+ let modl = assert (isExternalName n) $ GHC.nameModule n
+ if not (GHC.isExternalName n)
+ then noCanDo n $ ppr n <>
+ text " is not defined in an interpreted module"
+ else do
+ is_interpreted <- GHC.moduleIsInterpreted modl
+ if not is_interpreted
+ then noCanDo n $ text "module " <> ppr modl <>
+ text " is not interpreted"
+ else and_then n
clearCaches :: GhciMonad m => m ()
clearCaches = discardActiveBreakPoints
=====================================
m4/fp_set_cflags_c99.m4 deleted
=====================================
@@ -1,38 +0,0 @@
-# FP_SET_CFLAGS_C99
-# ----------------------------------
-# figure out which CFLAGS are needed to place the compiler into C99 mode
-# $1 is name of CC variable (unmodified)
-# $2 is name of CC flags variable (augmented if needed)
-# $3 is name of CPP flags variable (augmented if needed)
-AC_DEFUN([FP_SET_CFLAGS_C99],
-[
- dnl save current state of AC_PROG_CC_C99
- FP_COPY_SHELLVAR([CC],[fp_save_CC])
- FP_COPY_SHELLVAR([CFLAGS],[fp_save_CFLAGS])
- FP_COPY_SHELLVAR([CPPFLAGS],[fp_save_CPPFLAGS])
- FP_COPY_SHELLVAR([ac_cv_prog_cc_c99],[fp_save_cc_c99])
- dnl set local state
- CC="$$1"
- CFLAGS="$$2"
- CPPFLAGS="$$3"
- unset ac_cv_prog_cc_c99
- dnl perform detection
- AC_PROG_CC_C99
- fp_cc_c99="$ac_cv_prog_cc_c99"
- case "x$ac_cv_prog_cc_c99" in
- x) ;; # noop
- xno) AC_MSG_ERROR([C99-compatible compiler needed]) ;;
- *) $2="$$2 $ac_cv_prog_cc_c99"
- $3="$$3 $ac_cv_prog_cc_c99"
- ;;
- esac
- dnl restore saved state
- FP_COPY_SHELLVAR([fp_save_CC],[CC])
- FP_COPY_SHELLVAR([fp_save_CFLAGS],[CFLAGS])
- FP_COPY_SHELLVAR([fp_save_CPPFLAGS],[CPPFLAGS])
- FP_COPY_SHELLVAR([fp_save_cc_c99],[ac_cv_prog_cc_c99])
- dnl cleanup
- unset fp_save_CC
- unset fp_save_CFLAGS
- unset fp_save_cc_c99
-])
=====================================
testsuite/tests/ghci/T16392/all.T
=====================================
@@ -1,5 +1,7 @@
test('T16392',
[extra_files(['A.hs']),
when(config.have_RTS_linker,extra_ways(['ghci-ext'])),
- req_interp],
+ req_interp,
+ when(opsys('mingw32'), fragile(22649))
+ ],
ghci_script, ['T16392.script'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f1ca3dd1aafbdd6e7ac68da679473870d97a54e6...8965610f0aa2b1366012c60b03766eb1edbbcf34
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f1ca3dd1aafbdd6e7ac68da679473870d97a54e6...8965610f0aa2b1366012c60b03766eb1edbbcf34
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/20221220/d70ff610/attachment-0001.html>
More information about the ghc-commits
mailing list