Skip to content
Snippets Groups Projects
Commit bfe600f5 authored by Rodrigo Mesquita's avatar Rodrigo Mesquita :seedling: Committed by Marge Bot
Browse files

ghc-internal: No trailing whitespace in exceptions

Fixes #25052
parent d94410f8
No related branches found
No related tags found
No related merge requests found
Pipeline #99076 canceled
......@@ -45,6 +45,7 @@ module GHC.Internal.Exception.Type
, underflowException
) where
import GHC.Internal.Data.OldList (intersperse)
import GHC.Internal.Data.Maybe
import GHC.Internal.Data.Typeable (Typeable, TypeRep, cast)
import qualified GHC.Internal.Data.Typeable as Typeable
......@@ -213,11 +214,14 @@ instance Exception SomeException where
fromException = Just
backtraceDesired (SomeException e) = backtraceDesired e
displayException (SomeException e) =
displayException e
++ displayTypeInfo (Typeable.typeOf e)
++ "\n\n"
++ (displayContext ?exceptionContext)
case displayContext ?exceptionContext of
"" -> msg
dc -> msg ++ "\n\n" ++ dc
where
msg =
displayException e
++ displayTypeInfo (Typeable.typeOf e)
displayTypeInfo :: TypeRep -> String
displayTypeInfo rep =
mconcat
......@@ -232,10 +236,9 @@ instance Exception SomeException where
tyCon = Typeable.typeRepTyCon rep
displayContext :: ExceptionContext -> String
displayContext (ExceptionContext anns0) = go anns0
displayContext (ExceptionContext anns0) = mconcat $ intersperse "\n" $ map go anns0
where
go (SomeExceptionAnnotation ann : anns) = displayExceptionAnnotation ann ++ "\n" ++ go anns
go [] = ""
go (SomeExceptionAnnotation ann) = displayExceptionAnnotation ann
newtype NoBacktrace e = NoBacktrace e
deriving (Show)
......
......@@ -17,7 +17,6 @@ HasCallStack backtrace:
throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:453:5 in ghc-internal:GHC.Internal.IO.Exception
assert, called at main.hs:3:8 in main:Main
With -fignore-asserts
[1 of 2] Compiling Main ( main.hs, main.o ) [Optimisation flags changed]
[2 of 2] Linking main [Objects changed]
......
import Control.Exception
main :: IO ()
main = do
let msg = "no trailing whitespace"
fail msg `catch` \(e :: SomeException) -> do
putStrLn (displayException e)
user error (no trailing whitespace)
Package: ghc-internal
Module: GHC.Internal.IO.Exception
Type: IOException
test('T25052', normal, compile_and_run, [''])
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment