[Git][ghc/ghc][master] 2 commits: ghc-internal: @since for backtraceDesired

[Marge Bot (@marge-bot)]

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


Commits:
d94410f8 by Rodrigo Mesquita at 2024-08-07T11:49:19-04:00
ghc-internal: @since for backtraceDesired

Fixes point 1 in #25052

- - - - -
bfe600f5 by Rodrigo Mesquita at 2024-08-07T11:49:19-04:00
ghc-internal: No trailing whitespace in exceptions

Fixes #25052

- - - - -


5 changed files:

- libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs
- testsuite/tests/driver/T13914/T13914.stdout
- + testsuite/tests/exceptions/T25052.hs
- + testsuite/tests/exceptions/T25052.stdout
- + testsuite/tests/exceptions/all.T


Changes:

=====================================
libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs
=====================================
@@ -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
@@ -196,6 +197,7 @@ class (Typeable e, Show e) => Exception e where
     displayException :: e -> String
     displayException = show
 
+    -- | @since base-4.20.0.0
     backtraceDesired :: e -> Bool
     backtraceDesired _ = True
 
@@ -212,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
@@ -231,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)


=====================================
testsuite/tests/driver/T13914/T13914.stdout
=====================================
@@ -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]


=====================================
testsuite/tests/exceptions/T25052.hs
=====================================
@@ -0,0 +1,8 @@
+import Control.Exception
+
+main :: IO ()
+main = do
+  let msg = "no trailing whitespace"
+  fail msg `catch` \(e :: SomeException) -> do
+    putStrLn (displayException e)
+


=====================================
testsuite/tests/exceptions/T25052.stdout
=====================================
@@ -0,0 +1,5 @@
+user error (no trailing whitespace)
+
+Package: ghc-internal
+Module: GHC.Internal.IO.Exception
+Type: IOException


=====================================
testsuite/tests/exceptions/all.T
=====================================
@@ -0,0 +1,2 @@
+test('T25052', normal, compile_and_run, [''])
+



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb1cb53647ff8770a29510a198b829a2426a5108...bfe600f5bb3ecd2c8fa71c536c63d3c46984e3f8

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb1cb53647ff8770a29510a198b829a2426a5108...bfe600f5bb3ecd2c8fa71c536c63d3c46984e3f8
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/20240807/fdc1d217/attachment-0001.html>