[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: No shadowing warnings for NoFieldSelector fields
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Jan 30 00:59:44 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
ced2e731 by sheaf at 2024-01-29T17:27:12-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
- - - - -
8eeadfad by Patrick at 2024-01-29T17:27:51-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`.
- - - - -
04f40de7 by Alexey Radkov at 2024-01-29T19:59:37-05:00
Fix irrelevant dodgy-foreign-imports warning on import f-pointers by value
A test *сс018* is attached (not sure about the naming convention though).
Note that without the fix, the test fails with the *dodgy-foreign-imports*
warning passed to stderr. The warning disappears after the fix.
GHC shouldn't warn on imports of natural function pointers from C by value
(which is feasible with CApiFFI), such as
```haskell
foreign import capi "cc018.h value f" f :: FunPtr (Int -> IO ())
```
where
```c
void (*f)(int);
```
See a related real-world use-case
[here](https://gitlab.com/daniel-casanueva/pcre-light/-/merge_requests/17).
There, GHC warns on import of C function pointer `pcre_free`.
- - - - -
72b440f5 by Alexey Radkov at 2024-01-29T19:59:38-05:00
Rename test cc018 -> T24034
- - - - -
68d4214d by Ben Gamari at 2024-01-29T19:59:38-05:00
rts/TraverseHeap.c: Ensure that PosixSource.h is included first
- - - - -
14 changed files:
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Tc/Gen/Foreign.hs
- rts/TraverseHeap.c
- + testsuite/tests/ffi/should_compile/T24034.h
- + testsuite/tests/ffi/should_compile/T24034.hs
- testsuite/tests/ffi/should_compile/all.T
- + 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/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
=====================================
compiler/GHC/Tc/Gen/Foreign.hs
=====================================
@@ -356,7 +356,7 @@ tcCheckFIType arg_tys res_ty idecl@(CImport src (L lc cconv) (L ls safety) mh
dflags <- getDynFlags
checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys
checkForeignRes nonIOok checkSafe (isFFIImportResultTy dflags) res_ty
- checkMissingAmpersand idecl (map scaledThing arg_tys) res_ty
+ checkMissingAmpersand idecl target (map scaledThing arg_tys) res_ty
case target of
StaticTarget _ _ _ False
| not (null arg_tys) ->
@@ -373,8 +373,10 @@ checkCTarget idecl (StaticTarget _ str _ _) = do
checkCTarget _ DynamicTarget = panic "checkCTarget DynamicTarget"
-checkMissingAmpersand :: ForeignImport GhcRn -> [Type] -> Type -> TcM ()
-checkMissingAmpersand idecl arg_tys res_ty
+checkMissingAmpersand :: ForeignImport GhcRn -> CCallTarget -> [Type] -> Type -> TcM ()
+checkMissingAmpersand _ (StaticTarget _ _ _ False) _ _ = return ()
+
+checkMissingAmpersand idecl _ arg_tys res_ty
| null arg_tys && isFunPtrTy res_ty
= addDiagnosticTc $ TcRnFunPtrImportWithoutAmpersand idecl
| otherwise
=====================================
rts/TraverseHeap.c
=====================================
@@ -9,10 +9,10 @@
#if defined(PROFILING)
-#include <string.h>
#include "rts/PosixSource.h"
#include "Rts.h"
#include "sm/Storage.h"
+#include <string.h>
#include "TraverseHeap.h"
=====================================
testsuite/tests/ffi/should_compile/T24034.h
=====================================
@@ -0,0 +1 @@
+void (*f)(int);
=====================================
testsuite/tests/ffi/should_compile/T24034.hs
=====================================
@@ -0,0 +1,5 @@
+{-# LANGUAGE ForeignFunctionInterface, CApiFFI #-}
+module ShouldCompile where
+
+import Foreign
+foreign import capi "T24034.h value f" f :: FunPtr (Int -> IO ())
=====================================
testsuite/tests/ffi/should_compile/all.T
=====================================
@@ -47,3 +47,5 @@ test('T22043', normal, compile, [''])
test('T22774', unless(js_arch(), expect_fail), compile, [''])
+test('T24034', normal, compile, [''])
+
=====================================
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/c5a4160035f72a604718e6643097475eeb2043ca...68d4214d36d1566bb223b9983190f3bed08f405b
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c5a4160035f72a604718e6643097475eeb2043ca...68d4214d36d1566bb223b9983190f3bed08f405b
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/12dcfdbf/attachment-0001.html>
More information about the ghc-commits
mailing list