summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAdam Gundry <adam@well-typed.com>2021-01-26 22:02:08 +0000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-02-16 16:39:14 -0500
commit7686f9f80d31d724b2e84b229de5efffbe6e45b4 (patch)
treebe32d6fb87cf5984fcf7b7de76121b6ac6c93cc0
parentc2029001d0f717dad68770a652262445bbec1c91 (diff)
downloadhaskell-7686f9f80d31d724b2e84b229de5efffbe6e45b4.tar.gz
Avoid false redundant import warning with DisambiguateRecordFields
Fixes #17853. We mustn't discard the result of pickGREs, because doing so might lead to incorrect redundant import warnings.
-rw-r--r--compiler/GHC/Rename/Env.hs14
-rw-r--r--testsuite/tests/rename/should_compile/T17853.hs17
-rw-r--r--testsuite/tests/rename/should_compile/T17853A.hs4
-rw-r--r--testsuite/tests/rename/should_compile/all.T1
4 files changed, 30 insertions, 6 deletions
diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index 48ec8db86c..4b5d5d7af3 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -502,13 +502,15 @@ lookupRecFieldOcc mb_con rdr_name
; env <- getGlobalRdrEnv
; let lbl = occNameFS (rdrNameOcc rdr_name)
mb_field = do fl <- find ((== lbl) . flLabel) flds
- -- We have the label, now check it is in
- -- scope (with the correct qualifier if
- -- there is one, hence calling pickGREs).
+ -- We have the label, now check it is in scope. If
+ -- there is a qualifier, use pickGREs to check that
+ -- the qualifier is correct, and return the filtered
+ -- GRE so we get import usage right (see #17853).
gre <- lookupGRE_FieldLabel env fl
- guard (not (isQual rdr_name
- && null (pickGREs rdr_name [gre])))
- return (fl, gre)
+ if isQual rdr_name
+ then do gre' <- listToMaybe (pickGREs rdr_name [gre])
+ return (fl, gre')
+ else return (fl, gre)
; case mb_field of
Just (fl, gre) -> do { addUsedGRE True gre
; return (flSelector fl) }
diff --git a/testsuite/tests/rename/should_compile/T17853.hs b/testsuite/tests/rename/should_compile/T17853.hs
new file mode 100644
index 0000000000..c44ae4a303
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T17853.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# OPTIONS_GHC -Werror=unused-imports #-}
+module T17853 where
+
+-- All the imports of T17853A are necessary, so they should not be reported as
+-- redundant. DisambiguateRecordFields has special logic for looking up field
+-- labels in record field construction because the module qualifier is optional.
+-- Previously this incorrectly reported imports as redundant if they were used
+-- only for fields that were in scope under a different prefix (see #17853).
+import qualified T17853A
+import qualified T17853A as X (X(..))
+import qualified T17853A as Y (Y(..))
+
+main :: IO ()
+main = do
+ print T17853A.X { X.name = "hello" }
+ print T17853A.Y { Y.age = 3 }
diff --git a/testsuite/tests/rename/should_compile/T17853A.hs b/testsuite/tests/rename/should_compile/T17853A.hs
new file mode 100644
index 0000000000..0d757a5af3
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T17853A.hs
@@ -0,0 +1,4 @@
+module T17853A where
+
+data X = X { name :: String } deriving Show
+data Y = Y { age :: Int } deriving Show
diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T
index 92f186075e..71d631e499 100644
--- a/testsuite/tests/rename/should_compile/all.T
+++ b/testsuite/tests/rename/should_compile/all.T
@@ -177,3 +177,4 @@ test('T17837', normal, compile, [''])
test('T18497', [], makefile_test, ['T18497'])
test('T18264', [], makefile_test, ['T18264'])
test('T18302', expect_broken(18302), compile, [''])
+test('T17853', [], multimod_compile, ['T17853', '-v0'])