[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: base: with{Binary}File{Blocking} only annotates own exceptions
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Mon Jan 29 15:37:08 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
82a1c656 by Sebastian Nagel at 2024-01-29T02:32:40-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.
- - - - -
9294a086 by Andreas Klebinger at 2024-01-29T02:33:15-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
- - - - -
da044677 by sheaf at 2024-01-29T10:36:59-05:00
No shadowing warnings for NoFieldSelector fields
This commit ensures we don't emit shadowing warnings when a user
shadows a field defined with NoFieldSelectors.
Fixes #24381
- - - - -
c5a41600 by Patrick at 2024-01-29T10:37:00-05:00
Fix bug wrong span of nested_doc_comment #24378
close #24378
1. Update the start position of span in `nested_doc_comment` correctly.
and hence the spans of identifiers of haddoc can be computed correctly.
2. add test `HaddockSpanIssueT24378`.
- - - - -
25 changed files:
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Rename/Utils.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
- + testsuite/tests/overloadedrecflds/should_compile/T24381.hs
- testsuite/tests/overloadedrecflds/should_compile/all.T
- testsuite/tests/showIface/DocsInHiFile1.stdout
- + testsuite/tests/showIface/HaddockSpanIssueT24378.hs
- + testsuite/tests/showIface/HaddockSpanIssueT24378.stdout
- testsuite/tests/showIface/Makefile
- testsuite/tests/showIface/all.T
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 ]
=====================================
compiler/GHC/Parser/Lexer.x
=====================================
@@ -1485,7 +1485,7 @@ nested_comment span buf len _buf2 = {-# SCC "nested_comment" #-} do
nested_doc_comment :: Action
nested_doc_comment span buf _len _buf2 = {-# SCC "nested_doc_comment" #-} withLexedDocType worker
where
- worker input docType _checkNextLine = nested_comment_logic endComment "" input span
+ worker input@(AI start_loc _) docType _checkNextLine = nested_comment_logic endComment "" input (mkPsSpan start_loc (psSpanEnd span))
where
endComment input lcomment
= docCommentEnd input (docType (\d -> NestedDocString d (mkHsDocStringChunk . dropTrailingDec <$> lcomment))) buf span
=====================================
compiler/GHC/Rename/Utils.hs
=====================================
@@ -182,7 +182,7 @@ checkShadowedOccs (global_env,local_env) get_loc_occ ns
where
(loc,occ) = get_loc_occ n
mb_local = lookupLocalRdrOcc local_env occ
- gres = lookupGRE global_env (LookupRdrName (mkRdrUnqual occ) (RelevantGREsFOS WantBoth))
+ gres = lookupGRE global_env (LookupRdrName (mkRdrUnqual occ) (RelevantGREsFOS WantNormal))
-- Make an Unqualified RdrName and look that up, so that
-- we don't find any GREs that are in scope qualified-only
=====================================
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)
=====================================
testsuite/tests/overloadedrecflds/should_compile/T24381.hs
=====================================
@@ -0,0 +1,6 @@
+{-# OPTIONS_GHC -Wname-shadowing #-}
+{-# LANGUAGE Haskell2010 #-} -- Necessary to avoid `NamedFieldPuns` from `GHC2021`.
+{-# LANGUAGE NoFieldSelectors #-}
+module M where
+data T = C { x :: () }
+f x = x
=====================================
testsuite/tests/overloadedrecflds/should_compile/all.T
=====================================
@@ -60,3 +60,4 @@ test('T23557', [extra_files(['T23557_aux.hs'])], multimod_compile, ['T23557', '-
test('T24293', req_th, compile, [''])
test('T24293b', req_th, compile, [''])
test('T24293c', req_th, compile_fail, [''])
+test('T24381', normal, compile, [''])
=====================================
testsuite/tests/showIface/DocsInHiFile1.stdout
=====================================
@@ -6,11 +6,11 @@ docs:
'<>', ':=:', 'Bool'
-}
identifiers:
- {DocsInHiFile.hs:2:3-6}
+ {DocsInHiFile.hs:2:6-9}
Data.Foldable.elem
- {DocsInHiFile.hs:2:3-6}
+ {DocsInHiFile.hs:2:6-9}
elem
- {DocsInHiFile.hs:2:11-15}
+ {DocsInHiFile.hs:2:14-18}
System.IO.print
{DocsInHiFile.hs:4:2-3}
GHC.Base.<>
=====================================
testsuite/tests/showIface/HaddockSpanIssueT24378.hs
=====================================
@@ -0,0 +1,9 @@
+{-| `elem`, 'print',
+`Unknown',
+'<>', ':=:', 'Bool'
+-}
+module HaddockSpanIssueT24378 ( HaddockSpanIssueT24378.elem) where
+
+{-| '()', 'elem'.-}
+elem :: ()
+elem = ()
=====================================
testsuite/tests/showIface/HaddockSpanIssueT24378.stdout
=====================================
@@ -0,0 +1,83 @@
+docs:
+ Just module header:
+ Just text:
+ {-| `elem`, 'print',
+`Unknown',
+'<>', ':=:', 'Bool'
+-}
+ identifiers:
+ {HaddockSpanIssueT24378.hs:1:6-9}
+ Data.Foldable.elem
+ {HaddockSpanIssueT24378.hs:1:6-9}
+ elem
+ {HaddockSpanIssueT24378.hs:1:14-18}
+ System.IO.print
+ {HaddockSpanIssueT24378.hs:3:2-3}
+ GHC.Base.<>
+ {HaddockSpanIssueT24378.hs:3:15-18}
+ GHC.Types.Bool
+ declaration docs:
+ [elem -> [text:
+ {-| '()', 'elem'.-}
+ identifiers:
+ {HaddockSpanIssueT24378.hs:7:12-15}
+ Data.Foldable.elem
+ {HaddockSpanIssueT24378.hs:7:12-15}
+ elem]]
+ arg docs:
+ []
+ documentation structure:
+ avails:
+ [elem]
+ named chunks:
+ haddock options:
+ language:
+ Nothing
+ language extensions:
+ MonomorphismRestriction
+ RelaxedPolyRec
+ ForeignFunctionInterface
+ ImplicitPrelude
+ ScopedTypeVariables
+ BangPatterns
+ NamedFieldPuns
+ GADTSyntax
+ DoAndIfThenElse
+ ConstraintKinds
+ PolyKinds
+ InstanceSigs
+ StandaloneDeriving
+ DeriveDataTypeable
+ DeriveFunctor
+ DeriveTraversable
+ DeriveFoldable
+ DeriveGeneric
+ DeriveLift
+ TypeSynonymInstances
+ FlexibleContexts
+ FlexibleInstances
+ ConstrainedClassMethods
+ MultiParamTypeClasses
+ ExistentialQuantification
+ EmptyDataDecls
+ KindSignatures
+ GeneralizedNewtypeDeriving
+ PostfixOperators
+ TupleSections
+ PatternGuards
+ RankNTypes
+ TypeOperators
+ ExplicitForAll
+ TraditionalRecordSyntax
+ BinaryLiterals
+ HexFloatLiterals
+ EmptyCase
+ NamedWildCards
+ TypeApplications
+ EmptyDataDeriving
+ NumericUnderscores
+ StarIsType
+ ImportQualifiedPost
+ StandaloneKindSignatures
+ FieldSelectors
+extensible fields:
=====================================
testsuite/tests/showIface/Makefile
=====================================
@@ -42,6 +42,10 @@ HaddockIssue849:
'$(TEST_HC)' $(TEST_HC_OPTS) -c -haddock HaddockIssue849.hs
'$(TEST_HC)' $(TEST_HC_OPTS) --show-iface HaddockIssue849.hi | grep -A 200 'docs:'
+HaddockSpanIssueT24378:
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c -haddock HaddockSpanIssueT24378.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) --show-iface HaddockSpanIssueT24378.hi | grep -A 200 'docs:'
+
MagicHashInHaddocks:
'$(TEST_HC)' $(TEST_HC_OPTS) -c -haddock MagicHashInHaddocks.hs
'$(TEST_HC)' $(TEST_HC_OPTS) --show-iface MagicHashInHaddocks.hi | grep -A 200 'docs:'
=====================================
testsuite/tests/showIface/all.T
=====================================
@@ -11,4 +11,5 @@ test('HaddockOpts', normal, makefile_test, [])
test('LanguageExts', normal, makefile_test, [])
test('ReExports', extra_files(['Inner0.hs', 'Inner1.hs', 'Inner2.hs', 'Inner3.hs', 'Inner4.hs']), makefile_test, [])
test('HaddockIssue849', normal, makefile_test, [])
+test('HaddockSpanIssueT24378', normal, makefile_test, [])
test('MagicHashInHaddocks', normal, makefile_test, [])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/68bd5c20daa521bedb7b0fc8b3838d56fab5e972...c5a4160035f72a604718e6643097475eeb2043ca
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/68bd5c20daa521bedb7b0fc8b3838d56fab5e972...c5a4160035f72a604718e6643097475eeb2043ca
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/20240129/286c1bb7/attachment-0001.html>
More information about the ghc-commits
mailing list