Zubin pushed to branch wip/annotation-fixes at Glasgow Haskell Compiler / GHC

Commits:

18 changed files:

Changes:

  • changelog.d/clc-446
    1
    +section: base
    
    2
    +synopsis: Preserve exception context when rethrowing exceptions in
    
    3
    +  ``modifyIOError`` and ``mapException``.
    
    4
    +issues: #27851
    
    5
    +mrs: !16747
    
    6
    +description:
    
    7
    +  See `CLC proposal 446 <https://github.com/haskell/core-libraries-committee/issues/446>`_.

  • changelog.d/clc-447
    1
    +section: base
    
    2
    +synopsis: Preserve exception context when rethrowing exceptions in ``hGetLine``,
    
    3
    +  ``hGetContents``, ``hGetContents'``, ``hClose``, ``executablePath``, and on
    
    4
    +  Windows in ``openFile``, ``openFileBlocking`` and ``openBinaryFile``.
    
    5
    +issues: #27875
    
    6
    +mrs: !16747
    
    7
    +description:
    
    8
    +  See `CLC proposal 447 <https://github.com/haskell/core-libraries-committee/issues/447>`_.

  • libraries/base/changelog.md
    ... ... @@ -11,6 +11,8 @@
    11 11
       * Add `withEmptyCallStack` to `GHC.Stack`. ([CLC proposal #428](https://github.com/haskell/core-libraries-committee/issues/428))
    
    12 12
       * Add new `Data.RealFloat` module re-exporting `RealFloat` from `GHC.Float` ([CLC proposal #394](https://github.com/haskell/core-libraries-committee/issues/394))
    
    13 13
       * Add `Infinity`, `NegInfinity`, and `NaN` pattern synonyms to `Data.RealFloat` ([CLC proposal #394](https://github.com/haskell/core-libraries-committee/issues/394))
    
    14
    +  * `modifyIOError` now preserves the original `ExceptionContext` instead of annotating the rethrown exception with `WhileHandling`. ([GHC #27851](https://gitlab.haskell.org/ghc/ghc/-/issues/27851))
    
    15
    +  * `mapException` now preserves the original `ExceptionContext` instead of annotating the mapped exception with `WhileHandling`. ([GHC #27851](https://gitlab.haskell.org/ghc/ghc/-/issues/27851))
    
    14 16
     
    
    15 17
     ## 4.23.0.0 *TBA*
    
    16 18
       * Add `System.IO.hGetNewlineMode`. ([CLC proposal #370](https://github.com/haskell/core-libraries-committee/issues/370))
    

  • libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs
    ... ... @@ -175,8 +175,8 @@ handleJust p = flip (catchJust p)
    175 175
     -- Notice that the usage of 'unsafePerformIO' is safe here.
    
    176 176
     
    
    177 177
     mapException :: (Exception e1, Exception e2) => (e1 -> e2) -> a -> a
    
    178
    -mapException f v = unsafePerformIO (catch (evaluate v)
    
    179
    -                                          (\x -> throwIO (f x)))
    
    178
    +mapException f v = unsafePerformIO $ catchNoPropagate (evaluate v) $
    
    179
    +  \(ExceptionWithContext ctx x) -> rethrowIO (ExceptionWithContext ctx (f x))
    
    180 180
     
    
    181 181
     -----------------------------------------------------------------------------
    
    182 182
     -- 'try' and variations.
    

  • libraries/ghc-internal/src/GHC/Internal/IO/Handle/Internals.hs
    ... ... @@ -193,7 +193,7 @@ do_operation fun h act m = do
    193 193
                 throwTo t e
    
    194 194
                 do_operation fun h act m
    
    195 195
             _otherwise ->
    
    196
    -            throwIO e
    
    196
    +            rethrowIO (ExceptionWithContext c e)
    
    197 197
     
    
    198 198
     -- Note [async]
    
    199 199
     -- ~~~~~~~~~~~~
    
    ... ... @@ -451,7 +451,7 @@ handleFinalizer fp m = do
    451 451
       (handle_', mb_exc) <- hClose_help handle_
    
    452 452
       putMVar m handle_'
    
    453 453
       case mb_exc of
    
    454
    -    Just exc -> throwIO exc
    
    454
    +    Just exc -> throwIO (NoBacktrace exc)
    
    455 455
         Nothing -> return ()
    
    456 456
     
    
    457 457
     {-
    
    ... ... @@ -885,8 +885,9 @@ hClose_maybethrow (Just e) h = hClose_rethrow e h
    885 885
     hClose_rethrow :: SomeException -> Handle -> IO ()
    
    886 886
     hClose_rethrow e h =
    
    887 887
       case fromException e of
    
    888
    -    Just ioe -> ioError (augmentIOError ioe "hClose" h)
    
    889
    -    Nothing  -> throwIO e
    
    888
    +    Just ioe -> rethrowIO $ ExceptionWithContext (someExceptionContext e) $
    
    889
    +                  augmentIOError ioe "hClose" h
    
    890
    +    Nothing  -> throwIO (NoBacktrace e)
    
    890 891
     
    
    891 892
     hClose' :: Handle -> MVar Handle__ -> IO (Maybe SomeException)
    
    892 893
     hClose' h m = withHandle' "hClose" h m $ hClose_help
    

  • libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs
    ... ... @@ -52,7 +52,6 @@ import qualified GHC.Internal.IO.Device as RawIO
    52 52
     import GHC.Internal.Foreign.C.Types
    
    53 53
     import GHC.Internal.Foreign.Storable
    
    54 54
     
    
    55
    -import qualified GHC.Internal.Control.Exception as Exception
    
    56 55
     import GHC.Internal.System.IO.Error
    
    57 56
     import GHC.Internal.Data.Either (Either(..))
    
    58 57
     import GHC.Internal.Data.Maybe
    
    ... ... @@ -267,13 +266,14 @@ hGetLineBufferedLoop handle_@Handle__{..}
    267 266
     
    
    268 267
     maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer)
    
    269 268
     maybeFillReadBuffer handle_ buf
    
    270
    -  = catchException
    
    269
    +  = catchNoPropagate
    
    271 270
          (do buf' <- getSomeCharacters handle_ buf
    
    272 271
              return (Just buf')
    
    273 272
          )
    
    274
    -     (\e -> do if isEOFError e
    
    273
    +     (\ec@(ExceptionWithContext _ e) ->
    
    274
    +               if isEOFError e
    
    275 275
                       then return Nothing
    
    276
    -                  else ioError e)
    
    276
    +                  else rethrowIO ec)
    
    277 277
     
    
    278 278
     -- See GHC.Internal.IO.Buffer
    
    279 279
     #define CHARBUF_UTF32
    
    ... ... @@ -421,7 +421,7 @@ lazyRead handle =
    421 421
     lazyReadBuffered :: Handle -> Handle__ -> IO (Handle__, [Char])
    
    422 422
     lazyReadBuffered h handle_@Handle__{..} = do
    
    423 423
        buf <- readIORef haCharBuffer
    
    424
    -   Exception.catch
    
    424
    +   catchNoPropagate
    
    425 425
             (do
    
    426 426
                 buf'@Buffer{..} <- getSomeCharacters handle_ buf
    
    427 427
                 lazy_rest <- lazyRead h
    
    ... ... @@ -432,7 +432,8 @@ lazyReadBuffered h handle_@Handle__{..} = do
    432 432
                 writeIORef haCharBuffer (bufferAdjustL r buf')
    
    433 433
                 return (handle_, s)
    
    434 434
             )
    
    435
    -        (\e -> do (handle_', _) <- hClose_help handle_
    
    435
    +        (\(ExceptionWithContext ctx e) -> do
    
    436
    +                  (handle_', _) <- hClose_help handle_
    
    436 437
                       debugIO ("hGetContents caught: " ++ show e)
    
    437 438
                       -- We might have a \r cached in CRLF mode.  So we
    
    438 439
                       -- need to check for that and return it:
    
    ... ... @@ -441,7 +442,8 @@ lazyReadBuffered h handle_@Handle__{..} = do
    441 442
                                          then "\r"
    
    442 443
                                          else ""
    
    443 444
                                  else
    
    444
    -                                  throw (augmentIOError e "hGetContents" h)
    
    445
    +                                  throw $ NoBacktrace $ ExceptionWithContext ctx $
    
    446
    +                                    augmentIOError e "hGetContents" h
    
    445 447
     
    
    446 448
                       return (handle_', r)
    
    447 449
             )
    
    ... ... @@ -496,7 +498,8 @@ hGetContents' handle = do
    496 498
           Right s -> return s
    
    497 499
           Left e ->
    
    498 500
               case fromException e of
    
    499
    -            Just ioe -> throwIO (augmentIOError ioe "hGetContents'" handle)
    
    501
    +            Just ioe -> rethrowIO $ ExceptionWithContext (someExceptionContext e) $
    
    502
    +                          augmentIOError ioe "hGetContents'" handle
    
    500 503
                 Nothing -> throwIO (NoBacktrace e)
    
    501 504
     
    
    502 505
     strictRead :: Handle -> Handle__ -> IO (Handle__, Either SomeException String)
    
    ... ... @@ -512,12 +515,13 @@ strictRead h handle_@Handle__{..} = do
    512 515
     
    
    513 516
     strictReadLoop :: Handle__ -> [CharBuffer] -> CharBuffer -> IO [CharBuffer]
    
    514 517
     strictReadLoop handle_ cbufs cbuf0 = do
    
    515
    -    mcbuf <- Exception.catch
    
    518
    +    mcbuf <- catchNoPropagate
    
    516 519
             (do r <- readTextDevice handle_ cbuf0
    
    517 520
                 return (Just r))
    
    518
    -        (\e -> if isEOFError e
    
    521
    +        (\ec@(ExceptionWithContext _ e) ->
    
    522
    +               if isEOFError e
    
    519 523
                       then return Nothing
    
    520
    -                  else throw e)
    
    524
    +                  else rethrowIO ec)
    
    521 525
         case mcbuf of
    
    522 526
           Nothing -> return (cbuf0 : cbufs)
    
    523 527
           Just cbuf1 -> strictReadLoop' handle_ cbufs cbuf1
    

  • libraries/ghc-internal/src/GHC/Internal/IO/Handle/Windows.hs
    ... ... @@ -28,6 +28,7 @@ import GHC.Internal.Base (String, fmap, otherwise, return, ($))
    28 28
     import qualified GHC.Internal.Base as Rebindable
    
    29 29
     import qualified GHC.Internal.Data.Typeable.Internal as Rebindable
    
    30 30
     import GHC.Internal.MVar
    
    31
    +import GHC.Internal.Exception.Type (ExceptionWithContext(..))
    
    31 32
     import GHC.Internal.IO
    
    32 33
     import GHC.Internal.IO.BufferedIO hiding (flushWriteBuffer)
    
    33 34
     import GHC.Internal.IO.Encoding
    
    ... ... @@ -114,6 +115,11 @@ addFilePathToIOError :: String -> FilePath -> IOException -> IOException
    114 115
     addFilePathToIOError fun fp ioe
    
    115 116
       = ioe{ ioe_location = fun, ioe_filename = Just fp }
    
    116 117
     
    
    118
    +catchAndAnnotate :: FilePath -> String -> IO a -> IO a
    
    119
    +catchAndAnnotate fp s a =
    
    120
    +  catchExceptionNoPropagate a $ \(ExceptionWithContext c e) ->
    
    121
    +    rethrowIO (ExceptionWithContext c (addFilePathToIOError s fp e))
    
    122
    +
    
    117 123
     -- | Computation 'openFile' @file mode@ allocates and returns a new, open
    
    118 124
     -- handle to manage the file @file@.  It manages input if @mode@
    
    119 125
     -- is 'ReadMode', output if @mode@ is 'WriteMode' or 'AppendMode',
    
    ... ... @@ -142,9 +148,8 @@ addFilePathToIOError fun fp ioe
    142 148
     -- be using 'openBinaryFile'.
    
    143 149
     openFile :: FilePath -> IOMode -> IO Handle
    
    144 150
     openFile fp im =
    
    145
    -  catchException
    
    146
    -    (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE True)
    
    147
    -    (\e -> ioError (addFilePathToIOError "openFile" fp e))
    
    151
    +  catchAndAnnotate fp "openFile" $
    
    152
    +    openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE True
    
    148 153
     
    
    149 154
     -- | Like 'openFile', but opens the file in ordinary blocking mode.
    
    150 155
     -- This can be useful for opening a FIFO for writing: if we open in
    
    ... ... @@ -154,9 +159,8 @@ openFile fp im =
    154 159
     -- @since base-4.4.0.0
    
    155 160
     openFileBlocking :: FilePath -> IOMode -> IO Handle
    
    156 161
     openFileBlocking fp im =
    
    157
    -  catchException
    
    158
    -    (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE False)
    
    159
    -    (\e -> ioError (addFilePathToIOError "openFileBlocking" fp e))
    
    162
    +  catchAndAnnotate fp "openFileBlocking" $
    
    163
    +    openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE False
    
    160 164
     
    
    161 165
     -- | Like 'openFile', but open the file in binary mode.
    
    162 166
     -- On Windows, reading a file in text mode (which is the default)
    
    ... ... @@ -169,9 +173,8 @@ openFileBlocking fp im =
    169 173
     
    
    170 174
     openBinaryFile :: FilePath -> IOMode -> IO Handle
    
    171 175
     openBinaryFile fp m =
    
    172
    -  catchException
    
    173
    -    (openFile' fp m True True)
    
    174
    -    (\e -> ioError (addFilePathToIOError "openBinaryFile" fp e))
    
    176
    +  catchAndAnnotate fp "openBinaryFile" $
    
    177
    +    openFile' fp m True True
    
    175 178
     
    
    176 179
     openFile' :: String -> IOMode -> Bool -> Bool -> IO Handle
    
    177 180
     openFile' filepath iomode binary non_blocking = do
    

  • libraries/ghc-internal/src/GHC/Internal/System/Environment/ExecutablePath.hsc
    ... ... @@ -44,7 +44,7 @@ executablePath = Nothing
    44 44
     import GHC.Internal.Maybe (Maybe(..))
    
    45 45
     import GHC.Internal.IO (FilePath)
    
    46 46
     #if defined(darwin_HOST_OS)
    
    47
    -import GHC.Internal.Control.Exception (catch, throw)
    
    47
    +import GHC.Internal.Control.Exception (catchJust)
    
    48 48
     import GHC.Internal.Err (errorWithoutStackTrace)
    
    49 49
     import GHC.Internal.Real
    
    50 50
     import GHC.Internal.Word
    
    ... ... @@ -66,7 +66,7 @@ import GHC.Internal.Foreign.Marshal.Array
    66 66
     import GHC.Internal.Real
    
    67 67
     import GHC.Internal.System.Posix.Internals
    
    68 68
     #elif defined(solaris2_HOST_OS)
    
    69
    -import GHC.Internal.Control.Exception (catch, throw)
    
    69
    +import GHC.Internal.Control.Exception (catchJust)
    
    70 70
     import GHC.Internal.Data.Functor
    
    71 71
     import GHC.Internal.Foreign.C.Types
    
    72 72
     import GHC.Internal.Foreign.C.Error
    
    ... ... @@ -75,7 +75,7 @@ import GHC.Internal.Foreign.Marshal.Array
    75 75
     import GHC.Internal.System.IO.Error (isDoesNotExistError)
    
    76 76
     import GHC.Internal.System.Posix.Internals
    
    77 77
     #elif defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS)
    
    78
    -import GHC.Internal.Control.Exception (catch, throw)
    
    78
    +import GHC.Internal.Control.Exception (catchJust)
    
    79 79
     import GHC.Internal.Data.Functor
    
    80 80
     import GHC.Internal.Foreign.C.Types
    
    81 81
     import GHC.Internal.Foreign.C.Error
    
    ... ... @@ -203,10 +203,10 @@ realpath path =
    203 203
     getExecutablePath = _NSGetExecutablePath >>= realpath
    
    204 204
     
    
    205 205
     -- realpath(3) fails with ENOENT file does not exist (e.g. was deleted)
    
    206
    -executablePath = Just (fmap Just getExecutablePath `catch` f)
    
    206
    +executablePath = Just (catchJust f (fmap Just getExecutablePath) (\_ -> pure Nothing))
    
    207 207
       where
    
    208
    -  f e | isDoesNotExistError e = pure Nothing
    
    209
    -      | otherwise             = throw e
    
    208
    +  f e | isDoesNotExistError e = Just ()
    
    209
    +      | otherwise             = Nothing
    
    210 210
     
    
    211 211
     --------------------------------------------------------------------------------
    
    212 212
     -- Linux / Solaris / Hurd
    
    ... ... @@ -242,12 +242,12 @@ executablePath = Just (check <$> getExecutablePath) where
    242 242
     #  elif defined(solaris2_HOST_OS)
    
    243 243
     getExecutablePath = readSymbolicLink "/proc/self/path/a.out"
    
    244 244
     
    
    245
    -executablePath = Just ((Just <$> getExecutablePath) `catch` f)
    
    245
    +executablePath = Just (catchJust f (Just <$> getExecutablePath) (\_ -> pure Nothing))
    
    246 246
       where
    
    247 247
         -- readlink(2) fails with ENOENT when the executable has been deleted,
    
    248 248
         -- even though the symlink itself still exists according to readdir(3).
    
    249
    -    f e | isDoesNotExistError e = pure Nothing
    
    250
    -        | otherwise             = throw e
    
    249
    +    f e | isDoesNotExistError e = Just ()
    
    250
    +        | otherwise             = Nothing
    
    251 251
     
    
    252 252
     #endif
    
    253 253
     
    
    ... ... @@ -297,15 +297,15 @@ getExecutablePath = do
    297 297
           ]
    
    298 298
     #  endif
    
    299 299
     
    
    300
    -executablePath = Just (fmap Just getExecutablePath `catch` f)
    
    300
    +executablePath = Just (catchJust f (fmap Just getExecutablePath) (\_ -> pure Nothing))
    
    301 301
       where
    
    302 302
       -- The sysctl fails with errno ENOENT when executable has been deleted;
    
    303 303
       -- see https://gitlab.haskell.org/ghc/ghc/-/issues/12377#note_321346.
    
    304
    -  f e | isDoesNotExistError e = pure Nothing
    
    304
    +  f e | isDoesNotExistError e = Just ()
    
    305 305
     
    
    306 306
       -- As far as I know, ENOENT is the only kind of failure that should be
    
    307 307
       -- expected and handled.  Re-throw other errors.
    
    308
    -      | otherwise             = throw e
    
    308
    +      | otherwise             = Nothing
    
    309 309
     
    
    310 310
     
    
    311 311
     --------------------------------------------------------------------------------
    

  • libraries/ghc-internal/src/GHC/Internal/System/IO/Error.hs
    ... ... @@ -319,9 +319,10 @@ ioeSetHandle ioe hdl = ioe{ ioe_handle = Just hdl }
    319 319
     ioeSetFileName    ioe filename = ioe{ ioe_filename = Just filename }
    
    320 320
     
    
    321 321
     -- | Catch any 'IOError' that occurs in the computation and throw a
    
    322
    --- modified version.
    
    322
    +-- modified version, preserving the original 'ExceptionContext'.
    
    323 323
     modifyIOError :: (IOError -> IOError) -> IO a -> IO a
    
    324
    -modifyIOError f io = catch io (\e -> throwIO (NoBacktrace $ f e))
    
    324
    +modifyIOError f io = catchNoPropagate io $ \(ExceptionWithContext ctx e) ->
    
    325
    +  rethrowIO (ExceptionWithContext ctx (f e))
    
    325 326
     
    
    326 327
     -- -----------------------------------------------------------------------------
    
    327 328
     -- annotating an IOError
    

  • testsuite/tests/exceptions/T27851.hs
    1
    +import System.IO.Error
    
    2
    +
    
    3
    +main :: IO ()
    
    4
    +main =
    
    5
    +  modifyIOError (`ioeSetLocation` "outer") $
    
    6
    +  modifyIOError (`ioeSetLocation` "inner") $
    
    7
    +  ioError (mkIOError doesNotExistErrorType "origin" Nothing (Just "file"))

  • testsuite/tests/exceptions/T27851.stderr
    1
    +T27851: Uncaught exception ghc-internal:GHC.Internal.IO.Exception.IOException:
    
    2
    +
    
    3
    +file: outer: does not exist
    
    4
    +
    
    5
    +HasCallStack backtrace:
    
    6
    +  ioError, called at T27851.hs:7:3 in main:Main
    
    7
    +

  • testsuite/tests/exceptions/T27851b.hs
    1
    +import Control.Exception
    
    2
    +
    
    3
    +newtype Wrapped = Wrapped String deriving Show
    
    4
    +instance Exception Wrapped
    
    5
    +
    
    6
    +main :: IO ()
    
    7
    +main = print (mapException (\(ErrorCall s) -> Wrapped s) (error "boom" :: Int))

  • testsuite/tests/exceptions/T27851b.stderr
    1
    +T27851b: Uncaught exception main:Main.Wrapped:
    
    2
    +
    
    3
    +Wrapped "boom"
    
    4
    +
    
    5
    +HasCallStack backtrace:
    
    6
    +  error, called at T27851b.hs:7:59 in main:Main
    
    7
    +

  • testsuite/tests/exceptions/T27851c.hs
    1
    +import Control.Exception
    
    2
    +import System.IO
    
    3
    +
    
    4
    +main :: IO ()
    
    5
    +main = do
    
    6
    +  withBinaryFile "T27851c.txt" WriteMode $ \h -> hPutStr h "\xff\n"
    
    7
    +  run "hGetLine" hGetLine
    
    8
    +  run "hGetContents'" hGetContents'
    
    9
    +  run "hGetContents" $ \h -> do
    
    10
    +    s <- hGetContents h
    
    11
    +    length s `seq` pure s
    
    12
    +
    
    13
    +run :: String -> (Handle -> IO String) -> IO ()
    
    14
    +run name act = do
    
    15
    +  r <- try $ withFile "T27851c.txt" ReadMode $ \h -> do
    
    16
    +    hSetEncoding h utf8
    
    17
    +    act h
    
    18
    +  case r of
    
    19
    +    Left e -> do
    
    20
    +      putStrLn ("-- " ++ name)
    
    21
    +      putStrLn (displayExceptionWithInfo e)
    
    22
    +    Right s -> print s

  • testsuite/tests/exceptions/T27851c.stdout
    1
    +-- hGetLine
    
    2
    +ghc-internal:GHC.Internal.IO.Exception.IOException:
    
    3
    +
    
    4
    +T27851c.txt: hGetLine: invalid argument (cannot decode byte sequence starting from 255)
    
    5
    +
    
    6
    +HasCallStack backtrace:
    
    7
    +  ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Failure.hs:214:23 in ghc-internal:GHC.Internal.IO.Encoding.Failure
    
    8
    +
    
    9
    +-- hGetContents'
    
    10
    +ghc-internal:GHC.Internal.IO.Exception.IOException:
    
    11
    +
    
    12
    +T27851c.txt: hGetContents': invalid argument (cannot decode byte sequence starting from 255)
    
    13
    +
    
    14
    +HasCallStack backtrace:
    
    15
    +  ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Failure.hs:214:23 in ghc-internal:GHC.Internal.IO.Encoding.Failure
    
    16
    +
    
    17
    +-- hGetContents
    
    18
    +ghc-internal:GHC.Internal.IO.Exception.IOException:
    
    19
    +
    
    20
    +T27851c.txt: hGetContents: invalid argument (cannot decode byte sequence starting from 255)
    
    21
    +
    
    22
    +HasCallStack backtrace:
    
    23
    +  ioException, called at libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Failure.hs:214:23 in ghc-internal:GHC.Internal.IO.Encoding.Failure
    
    24
    +

  • testsuite/tests/exceptions/T27851d.hs
    1
    +import Control.Exception
    
    2
    +import System.IO
    
    3
    +
    
    4
    +main :: IO ()
    
    5
    +main = do
    
    6
    +  h <- openFile "/dev/full" WriteMode
    
    7
    +  hPutStr h "x"
    
    8
    +  r <- try (hClose h)
    
    9
    +  case r of
    
    10
    +    Left e -> putStrLn (displayExceptionWithInfo e)
    
    11
    +    Right () -> putStrLn "no exception"

  • testsuite/tests/exceptions/T27851d.stdout
    1
    +ghc-internal:GHC.Internal.IO.Exception.IOException:
    
    2
    +
    
    3
    +/dev/full: hClose: resource exhausted (No space left on device)
    
    4
    +
    
    5
    +HasCallStack backtrace:
    
    6
    +  ioError, called at libraries/ghc-internal/src/GHC/Internal/Foreign/C/Error.hs:293:5 in ghc-internal:GHC.Internal.Foreign.C.Error
    
    7
    +

  • testsuite/tests/exceptions/all.T
    1 1
     test('T25052', normal, compile_and_run, [''])
    
    2 2
     test('T26759', exit_code(1), compile_and_run, [''])
    
    3 3
     test('T26759a', exit_code(1), compile_and_run, [''])
    
    4
    +test('T27851', exit_code(1), compile_and_run, [''])
    
    5
    +test('T27851b', exit_code(1), compile_and_run, [''])
    
    6
    +test('T27851c', normal, compile_and_run, [''])
    
    7
    +test('T27851d', unless(opsys('linux'), skip), compile_and_run, [''])