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

Commits:

26 changed files:

Changes:

  • changelog.d/T27847
    1 
    +section: ghci
    2 
    +synopsis: Drop GHCi's own exception context when rethrowing exceptions in
    3 
    +  ``ghc -e`` and ``runghc``.
    4 
    +issues: #27847
    5 
    +mrs: !16747

  • changelog.d/T27851
    1 
    +section: base
    2 
    +synopsis: Preserve exception context when rethrowing exceptions in ``modifyIOError``.
    3 
    +issues: #27851
    4 
    +mrs: !16747

  • changelog.d/T27851b
    1 
    +section: base
    2 
    +synopsis: Preserve exception context when rethrowing exceptions in ``mapException``.
    3 
    +issues: #27851
    4 
    +mrs: !16747

  • changelog.d/T27851c
    1 
    +section: base
    2 
    +synopsis: Preserve exception context when rethrowing exceptions in ``hGetLine``,
    3 
    +  ``hGetContents`` and ``hGetContents'``.
    4 
    +issues: #27851
    5 
    +mrs: !16747

  • changelog.d/T27851d
    1 
    +section: base
    2 
    +synopsis: Preserve exception context when rethrowing exceptions in ``hClose``.
    3 
    +issues: #27851
    4 
    +mrs: !16747

  • changelog.d/T27851e
    1 
    +section: base
    2 
    +synopsis: Preserve exception context when rethrowing exceptions in ``openFile``,
    3 
    +  ``openFileBlocking`` and ``openBinaryFile`` on Windows.
    4 
    +issues: #27851
    5 
    +mrs: !16747

  • changelog.d/T27851f
    1 
    +section: base
    2 
    +synopsis: Preserve exception context when rethrowing exceptions in ``executablePath``.
    3 
    +issues: #27851
    4 
    +mrs: !16747

  • ghc/GHCi/UI/Monad.hs
    ... ... @@ -211,7 +211,7 @@ data CommandResult
    211 211 
        deriving Show
    212 212
    213 213 
     cmdSuccess :: MonadThrow m => CommandResult -> m (Maybe Bool)
    214 
    -cmdSuccess CommandComplete{ cmdResult = Left e } =
    214 
    +cmdSuccess CommandComplete{ cmdResult = Left (SomeException e) } =
    215 215 
       {- Don't add a backtrace from ghci/ghc to the exception from the user program! -}
    216 216 
     #if MIN_VERSION_base(4,21,0)
    217 217 
       throwM (NoBacktrace e)

  • 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, [''])

  • testsuite/tests/ghc-e/should_fail/T18441fail7.stderr
    ... ... @@ -5,10 +5,6 @@ IO error: "Abcde" does not exist
    5 5 
     While handling ghc-10.1-inplace:GHC.Utils.Panic.GhcException:
    6 6 
       |
    7 7 
       | IO error:  "Abcde" does not exist
    8 
    -  |
    9 
    -  | HasCallStack backtrace:
    10 
    -  |   throw, called at compiler/GHC/Utils/Panic.hs:180:21 in ghc-10.1-inplace:GHC.Utils.Panic
    11 
    -  |   throwGhcException, called at ghc/GHCi/UI.hs:2851:21 in ghc-bin-10.1.20260801-inplace:GHCi.UI
    12 8
    13 9 
     HasCallStack backtrace:
    14 10 
       throwIO, called at compiler/GHC/Utils/Error.hs:513:19 in ghc-10.1-inplace:GHC.Utils.Error

  • testsuite/tests/ghc-e/should_run/ghc-e005.stderr
    ... ... @@ -4,8 +4,3 @@ foo
    4 4
    5 5 
     HasCallStack backtrace:
    6 6 
       error, called at ghc-e005.hs:12:10 in main:Main
    7 
    -
    8 
    -
    9 
    -HasCallStack backtrace:
    10 
    -  throwIO, called at ghc\GHCi\UI.hs:1655:31 in ghc-bin-10.1.20260629-inplace:GHCi.UI
    11 
    -

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help Notification message regarding https://gitlab.haskell.org/ghc/ghc/-/compare/e6b8a645b484e1833839d8fa882370a96cacf84e...2b6d5865a17628f8248282a378b2eebec18a74b8 at 1790769736