[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: base: with{Binary}File{Blocking} only annotates own exceptions
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Mon Jan 29 02:32:35 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
64010b2a by Sebastian Nagel at 2024-01-28T21:32:30-05:00
base: with{Binary}File{Blocking} only annotates own exceptions
Fixes #20886
This ensures that inner, unrelated exceptions are not misleadingly
annotated with the opened file.
- - - - -
68bd5c20 by Andreas Klebinger at 2024-01-28T21:32:30-05:00
Fix fma warning when using llvm on aarch64.
On aarch64 fma is always on so the +fma flag doesn't exist for that
target. Hence no need to try and pass +fma to llvm.
Fixes #24379
- - - - -
16 changed files:
- compiler/GHC/Driver/Pipeline/Execute.hs
- libraries/base/changelog.md
- libraries/base/src/GHC/IO/Handle/FD.hs
- libraries/base/tests/IO/all.T
- + libraries/base/tests/IO/withBinaryFile001.hs
- + libraries/base/tests/IO/withBinaryFile001.stderr
- + libraries/base/tests/IO/withBinaryFile002.hs
- + libraries/base/tests/IO/withBinaryFile002.stderr
- + libraries/base/tests/IO/withFile001.hs
- + libraries/base/tests/IO/withFile001.stderr
- + libraries/base/tests/IO/withFile002.hs
- + libraries/base/tests/IO/withFile002.stderr
- + libraries/base/tests/IO/withFileBlocking001.hs
- + libraries/base/tests/IO/withFileBlocking001.stderr
- + libraries/base/tests/IO/withFileBlocking002.hs
- + libraries/base/tests/IO/withFileBlocking002.stderr
Changes:
=====================================
compiler/GHC/Driver/Pipeline/Execute.hs
=====================================
@@ -950,6 +950,7 @@ llvmOptions llvm_config dflags =
| otherwise = "static"
platform = targetPlatform dflags
+ arch = platformArch platform
attrs :: String
attrs = intercalate "," $ mattr
@@ -962,7 +963,8 @@ llvmOptions llvm_config dflags =
++ ["+avx512cd"| isAvx512cdEnabled dflags ]
++ ["+avx512er"| isAvx512erEnabled dflags ]
++ ["+avx512pf"| isAvx512pfEnabled dflags ]
- ++ ["+fma" | isFmaEnabled dflags ]
+ -- For Arch64 +fma is not a option (it's unconditionally available).
+ ++ ["+fma" | isFmaEnabled dflags && (arch /= ArchAArch64) ]
++ ["+bmi" | isBmiEnabled dflags ]
++ ["+bmi2" | isBmi2Enabled dflags ]
=====================================
libraries/base/changelog.md
=====================================
@@ -8,6 +8,7 @@
* Add laws relating between `Foldable` / `Traversable` with `Bifoldable` / `Bitraversable` ([CLC proposal #205](https://github.com/haskell/core-libraries-committee/issues/205))
* The `Enum Int64` and `Enum Word64` instances now use native operations on 32-bit platforms, increasing performance by up to 1.5x on i386 and up to 5.6x with the JavaScript backend. ([CLC proposal #187](https://github.com/haskell/core-libraries-committee/issues/187))
* Update to [Unicode 15.1.0](https://www.unicode.org/versions/Unicode15.1.0/).
+ * Fix `withFile`, `withFileBlocking`, and `withBinaryFile` to not incorrectly annotate exceptions raised in wrapped computation. ([CLC proposal #237](https://github.com/haskell/core-libraries-committee/issues/237))
* Fix `fdIsNonBlocking` to always be `0` for regular files and block devices on unix, regardless of `O_NONBLOCK`
* Always use `safe` call to `read` for regular files and block devices on unix if the RTS is multi-threaded, regardless of `O_NONBLOCK`.
([CLC proposal #166](https://github.com/haskell/core-libraries-committee/issues/166))
=====================================
libraries/base/src/GHC/IO/Handle/FD.hs
=====================================
@@ -27,7 +27,9 @@ module GHC.IO.Handle.FD (
import GHC.Base
import GHC.Show
+import Control.Exception (try)
import Data.Maybe
+import Data.Either (either)
import Data.Typeable
import Foreign.C.Types
import GHC.MVar
@@ -162,10 +164,12 @@ openFile fp im =
--
-- @since 4.16.0.0
withFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
-withFile fp im act =
+withFile fp im act = do
+ -- Only annotate when setup or teardown of withFile' raised the exception
catchException
- (withFile' fp im dEFAULT_OPEN_IN_BINARY_MODE True act)
+ (withFile' fp im dEFAULT_OPEN_IN_BINARY_MODE True (try . act))
(\e -> ioError (addFilePathToIOError "withFile" fp e))
+ >>= either ioError pure
-- | Like 'openFile', but opens the file in ordinary blocking mode.
-- This can be useful for opening a FIFO for writing: if we open in
@@ -196,10 +200,12 @@ openFileBlocking fp im =
--
-- @since 4.16.0.0
withFileBlocking :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
-withFileBlocking fp im act =
+withFileBlocking fp im act = do
+ -- Only annotate when setup or teardown of withFile' raised the exception
catchException
- (withFile' fp im dEFAULT_OPEN_IN_BINARY_MODE False act)
+ (withFile' fp im dEFAULT_OPEN_IN_BINARY_MODE False (try . act))
(\e -> ioError (addFilePathToIOError "withFileBlocking" fp e))
+ >>= either ioError pure
-- | Like 'openFile', but open the file in binary mode.
-- On Windows, reading a file in text mode (which is the default)
@@ -227,9 +233,11 @@ openBinaryFile fp m =
-- @since 4.16.0.0
withBinaryFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile fp im act =
+ -- Only annotate when setup or teardown of withFile' raised the exception
catchException
- (withFile' fp im True True act)
+ (withFile' fp im True True (try . act))
(\e -> ioError (addFilePathToIOError "withBinaryFile" fp e))
+ >>= either ioError pure
-- | Open a file and perform an action with it. If the action throws an
-- exception, then the file will be closed. If the last argument is 'True',
=====================================
libraries/base/tests/IO/all.T
=====================================
@@ -68,6 +68,13 @@ test('isEOF001', [extra_run_opts('</dev/null')], compile_and_run, [''])
test('misc001', [extra_run_opts('misc001.hs misc001.out')], compile_and_run,
[''])
+test('withFile001', [exit_code(1)], compile_and_run, [''])
+test('withFile002', [exit_code(1)], compile_and_run, [''])
+test('withFileBlocking001', [exit_code(1)], compile_and_run, [''])
+test('withFileBlocking002', [exit_code(1)], compile_and_run, [''])
+test('withBinaryFile001', [exit_code(1)], compile_and_run, [''])
+test('withBinaryFile002', [exit_code(1)], compile_and_run, [''])
+
test('openFile001', normal, compile_and_run, [''])
test('openFile002', [exit_code(1), normalise_win32_io_errors], compile_and_run, [''])
test('openFile003', normalise_win32_io_errors, compile_and_run, [''])
=====================================
libraries/base/tests/IO/withBinaryFile001.hs
=====================================
@@ -0,0 +1,8 @@
+-- | Test that withBinaryFile does report file not found exceptions.
+
+import System.IO
+
+main :: IO ()
+main =
+ withBinaryFile "test.bin" ReadMode $ \h ->
+ hGetContents' h >> pure ()
=====================================
libraries/base/tests/IO/withBinaryFile001.stderr
=====================================
@@ -0,0 +1 @@
+withBinaryFile001: test.bin: withBinaryFile: does not exist (No such file or directory)
=====================================
libraries/base/tests/IO/withBinaryFile002.hs
=====================================
@@ -0,0 +1,8 @@
+-- | Test that withBinaryFile does not annotate exceptions of inner computations.
+
+import System.IO
+
+main :: IO ()
+main =
+ withBinaryFile "test.bin" WriteMode $ \_ ->
+ fail "test"
=====================================
libraries/base/tests/IO/withBinaryFile002.stderr
=====================================
@@ -0,0 +1 @@
+withBinaryFile002: user error (test)
=====================================
libraries/base/tests/IO/withFile001.hs
=====================================
@@ -0,0 +1,8 @@
+-- | Test that withFile does report file not found exceptions.
+
+import System.IO
+
+main :: IO ()
+main =
+ withFile "test.txt" ReadMode $ \h ->
+ hGetContents' h >> pure ()
=====================================
libraries/base/tests/IO/withFile001.stderr
=====================================
@@ -0,0 +1 @@
+withFile001: test.txt: withFile: does not exist (No such file or directory)
=====================================
libraries/base/tests/IO/withFile002.hs
=====================================
@@ -0,0 +1,8 @@
+-- | Test that withFile does not annotate exceptions of inner computations.
+
+import System.IO
+
+main :: IO ()
+main =
+ withFile "test.txt" WriteMode $ \_ ->
+ fail "test"
=====================================
libraries/base/tests/IO/withFile002.stderr
=====================================
@@ -0,0 +1 @@
+withFile002: user error (test)
=====================================
libraries/base/tests/IO/withFileBlocking001.hs
=====================================
@@ -0,0 +1,10 @@
+-- | Test that withFileBlocking does report file not found exceptions.
+
+import System.IO
+import GHC.IO.Handle.FD
+
+-- | Test that withFileBlocking does report file not found exceptions.
+main :: IO ()
+main =
+ withFileBlocking "test.txt" ReadMode $ \h ->
+ hGetContents' h >> pure ()
=====================================
libraries/base/tests/IO/withFileBlocking001.stderr
=====================================
@@ -0,0 +1 @@
+withFileBlocking001: test.txt: withFileBlocking: does not exist (No such file or directory)
=====================================
libraries/base/tests/IO/withFileBlocking002.hs
=====================================
@@ -0,0 +1,9 @@
+-- | Test that withFileBlocking does not annotate exceptions of inner computations.
+
+import System.IO
+import GHC.IO.Handle.FD
+
+main :: IO ()
+main =
+ withFileBlocking "test.txt" WriteMode $ \_ ->
+ fail "test"
=====================================
libraries/base/tests/IO/withFileBlocking002.stderr
=====================================
@@ -0,0 +1 @@
+withFileBlocking002: user error (test)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/579eb8f976383137d7e0b1d4e7742a12885e5bfd...68bd5c20daa521bedb7b0fc8b3838d56fab5e972
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/579eb8f976383137d7e0b1d4e7742a12885e5bfd...68bd5c20daa521bedb7b0fc8b3838d56fab5e972
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/20240128/c62aead8/attachment-0001.html>
More information about the ghc-commits
mailing list