[Git][ghc/ghc][wip/romes/24792] 2 commits: ghc-toolchain: Fix error logging indentation
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Mon May 27 13:12:36 UTC 2024
Rodrigo Mesquita pushed to branch wip/romes/24792 at Glasgow Haskell Compiler / GHC
Commits:
8d61f111 by Rodrigo Mesquita at 2024-05-27T11:30:21+01:00
ghc-toolchain: Fix error logging indentation
- - - - -
09cf3263 by Rodrigo Mesquita at 2024-05-27T14:10:25+01:00
bindist: Correct default.target substitution
The substitution on `default.target.in` must be done after
`PREP_TARGET_FILE` is called -- that macro is responsible for
setting the variables that will be effectively substituted in the target
file. Otherwise, the target file is invalid.
Fixes #24792 #24574
- - - - -
5 changed files:
- distrib/configure.ac.in
- utils/ghc-toolchain/src/GHC/Toolchain/CheckArm.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Program.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Utils.hs
Changes:
=====================================
distrib/configure.ac.in
=====================================
@@ -358,15 +358,8 @@ if test "x$UseLibdw" = "xYES" ; then
fi
AC_SUBST(UseLibdw)
-
FP_SETTINGS
-AC_CONFIG_FILES([config.mk])
-AC_CONFIG_FILES([default.host.target])
-AC_CONFIG_FILES([default.target])
-AC_CONFIG_FILES([mk/hsc2hs])
-AC_OUTPUT
-
# We get caught by
# http://savannah.gnu.org/bugs/index.php?1516
# $(eval ...) inside conditionals causes errors
@@ -391,6 +384,12 @@ FIND_GHC_TOOLCHAIN_BIN([YES])
PREP_TARGET_FILE
FIND_GHC_TOOLCHAIN([.])
+AC_CONFIG_FILES([config.mk])
+AC_CONFIG_FILES([default.host.target])
+AC_CONFIG_FILES([default.target])
+AC_CONFIG_FILES([mk/hsc2hs])
+AC_OUTPUT
+
VALIDATE_GHC_TOOLCHAIN([default.target],[default.target.ghc-toolchain])
rm -Rf acargs acghc-toolchain actmp-ghc-toolchain
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/CheckArm.hs
=====================================
@@ -91,9 +91,8 @@ raspbianHack arch@(ArchARM ARMv6 _ abi) = do
raspbian <- isRaspbian
armv7 <- isARMv7Host
if raspbian && armv7
- then do logInfo $ unlines [ "Found compiler which claims to target ARMv6 running in Raspbian on ARMv7."
- , "Assuming we should actually target ARMv7 (see GHC #17856)"
- ]
+ then do logInfo "Found compiler which claims to target ARMv6 running in Raspbian on ARMv7."
+ logInfo "Assuming we should actually target ARMv7 (see GHC #17856)"
return $ ArchARM ARMv7 [VFPv2] abi
else return arch
where
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs
=====================================
@@ -7,7 +7,7 @@ module GHC.Toolchain.Monad
, runM
, getEnv
, makeM
- , throwE
+ , throwE, throwEs
, ifCrossCompiling
-- * File I/O
@@ -64,10 +64,17 @@ data Error = Error { errorMessage :: String
deriving (Show)
throwE :: String -> M a
-throwE msg = do
+throwE msg = throwEs [msg]
+
+-- | Throw an error with multiple lines.
+-- This should be used rather than `throwE . unlines` to preserve proper
+-- logging indentation.
+throwEs :: [String] -> M a
+throwEs msgs = do
e <- getEnv
- logInfo msg
- let err = Error { errorMessage = msg
+ forM_ msgs $ \msg -> do
+ logInfo msg
+ let err = Error { errorMessage = unlines msgs
, errorLogContexts = logContexts e
}
M (Except.throwE [err])
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Program.hs
=====================================
@@ -75,10 +75,10 @@ callProgram prog args = do
code <- runProgram prog args
case code of
ExitSuccess -> return ()
- ExitFailure n -> throwE (err n)
+ ExitFailure n -> throwEs (err n)
where
cmdline = [prgPath prog] ++ prgFlags prog ++ args
- err n = unlines
+ err n =
[ "Command failed: " ++ unwords cmdline
, "Exited with code " ++ show n
]
@@ -135,11 +135,11 @@ findProgram :: String
-> M Program
findProgram description userSpec candidates
| Just path <- poPath userSpec = do
- let err = unlines
+ let err =
[ "Failed to find " ++ description ++ "."
, "Looked for user-specified program '" ++ path ++ "' in the system search path."
]
- toProgram <$> find_it path <|> throwE err
+ toProgram <$> find_it path <|> throwEs err
| otherwise = do
env <- getEnv
@@ -148,11 +148,11 @@ findProgram description userSpec candidates
Just prefix -> map (prefix++) candidates
Nothing -> []
candidates' = prefixedCandidates ++ candidates
- err = unlines
+ err =
[ "Failed to find " ++ description ++ "."
, "Looked for one of " ++ show candidates' ++ " in the system search path."
]
- toProgram <$> oneOf err (map find_it candidates') <|> throwE err
+ toProgram <$> oneOf' err (map find_it candidates') <|> throwEs err
where
toProgram path = Program { prgPath = path, prgFlags = fromMaybe [] (poFlags userSpec) }
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Utils.hs
=====================================
@@ -6,6 +6,7 @@ module GHC.Toolchain.Utils
, expectFileExists
, withTempDir
, oneOf
+ , oneOf'
, isSuccess
) where
@@ -52,7 +53,12 @@ expectFileExists path err = do
unless exists $ throwE err
oneOf :: String -> [M b] -> M b
-oneOf err = foldr (<|>) (throwE err)
+oneOf err = oneOf' [err]
+
+-- | Like 'oneOf' but takes a multi-line error message if none of the checks
+-- succeed.
+oneOf' :: [String] -> [M b] -> M b
+oneOf' err = foldr (<|>) (throwEs err)
isSuccess :: ExitCode -> Bool
isSuccess = \case
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/de4680549db9dc68fab12cf6fcb951a8314a9d8e...09cf3263e75804cb84463524a86b191aa2a09aaf
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/de4680549db9dc68fab12cf6fcb951a8314a9d8e...09cf3263e75804cb84463524a86b191aa2a09aaf
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/20240527/ddf482ac/attachment-0001.html>
More information about the ghc-commits
mailing list