Renamer: don't call addUsedGRE on an exact Name

When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc,
we could end up calling addUsedGRE on an exact Name, which would then
lead to a panic in the bestImport function: it would be incapable of
processing a GRE which is not local but also not brought into scope
by any imports (as it is referred to by its unique instead).

Fixes #23240

6 files changed, 41 insertions, 16 deletions

diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index 2b4ecf2bc7..49fdde1bc6 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -534,30 +534,29 @@ lookupRecFieldOcc mb_con rdr_name
   = return $ mk_unbound_rec_fld con
   | Just con <- mb_con
   = do { let lbl = FieldLabelString $ occNameFS (rdrNameOcc rdr_name)
-       ; res <- lookupExactOrOrig rdr_name ensure_recfld $  -- See Note [Record field names and Template Haskell]
+       ; mb_nm <- lookupExactOrOrig rdr_name ensure_recfld $  -- See Note [Record field names and Template Haskell]
             do { flds <- lookupConstructorFields con
                ; env <- getGlobalRdrEnv
-               ; let lbl    = FieldLabelString $ occNameFS (rdrNameOcc rdr_name)
-                     mb_gre = do fl <- find ((== lbl) . flLabel) flds
+               ; let mb_gre = do fl <- find ((== lbl) . flLabel) flds
                                  -- 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
                                  if isQual rdr_name
-                                 then listToMaybe (pickGREs rdr_name [gre])
+                                 then listToMaybe $ pickGREs rdr_name [gre]
                                  else return gre
                ; traceRn "lookupRecFieldOcc" $
                    vcat [ text "mb_con:" <+> ppr mb_con
                         , text "rdr_name:" <+> ppr rdr_name
                         , text "flds:" <+> ppr flds
                         , text "mb_gre:" <+> ppr mb_gre ]
-               ; return mb_gre }
-        ; case res of
+               ; mapM_ (addUsedGRE True) mb_gre
+               ; return $ flSelector . fieldGRELabel <$> mb_gre }
+       ; case mb_nm of
           { Nothing  -> do { addErr (badFieldConErr con lbl)
                            ; return $ mk_unbound_rec_fld con }
-          ; Just gre -> do { addUsedGRE True gre
-                           ; return (flSelector $ fieldGRELabel gre) } } }
+          ; Just nm -> return nm } }
 
   | otherwise  -- Can't use the data constructor to disambiguate
   = greName <$> lookupGlobalOccRn' (IncludeFields WantField) rdr_name
@@ -572,7 +571,9 @@ lookupRecFieldOcc mb_con rdr_name
       mkRecFieldOccFS (getOccFS con) (occNameFS occ)
     occ = rdrNameOcc rdr_name
 
-    ensure_recfld gre = do { guard (isRecFldGRE gre) ; return gre }
+    ensure_recfld :: GlobalRdrElt -> Maybe Name
+    ensure_recfld gre = do { guard (isRecFldGRE gre)
+                           ; return $ greName gre }
 
 {- Note [DisambiguateRecordFields]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index e46d803287..aae3fe497b 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -1855,7 +1855,10 @@ mkImportMap gres
        RealSrcLoc decl_loc _ -> Map.insertWith add decl_loc [gre] imp_map
        UnhelpfulLoc _ -> imp_map
        where
-          best_imp_spec = bestImport (bagToList imp_specs)
+          best_imp_spec =
+            case bagToList imp_specs of
+              []     -> pprPanic "mkImportMap: GRE with no ImportSpecs" (ppr gre)
+              is:iss -> bestImport (is NE.:| iss)
           add _ gres = gre : gres
 
 warnUnusedImport :: WarningFlag -> GlobalRdrEnv
diff --git a/compiler/GHC/Types/Name/Reader.hs b/compiler/GHC/Types/Name/Reader.hs
index 928bac9c0c..6b8568d98e 100644
--- a/compiler/GHC/Types/Name/Reader.hs
+++ b/compiler/GHC/Types/Name/Reader.hs
@@ -126,7 +126,6 @@ import GHC.Utils.Panic
 import Control.DeepSeq
 import Control.Monad ( guard )
 import Data.Data
-import Data.List ( sortBy )
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Map.Strict as Map
 import qualified Data.Semigroup as S
@@ -1654,12 +1653,9 @@ data ImpItemSpec
         -- only @T@ is named explicitly.
   deriving (Eq, Data)
 
-bestImport :: [ImportSpec] -> ImportSpec
+bestImport :: NE.NonEmpty ImportSpec -> ImportSpec
 -- See Note [Choosing the best import declaration]
-bestImport iss
-  = case sortBy best iss of
-      (is:_) -> is
-      []     -> pprPanic "bestImport" (ppr iss)
+bestImport iss = NE.head $ NE.sortBy best iss
   where
     best :: ImportSpec -> ImportSpec -> Ordering
     -- Less means better
diff --git a/testsuite/tests/rename/should_compile/T23240.hs b/testsuite/tests/rename/should_compile/T23240.hs
new file mode 100644
index 0000000000..f498e9ba50
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T23240.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE Haskell2010 #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+-- Crucial to triggering the bug.
+{-# LANGUAGE DisambiguateRecordFields #-}
+
+-- Need to enable the unused imports warning to trigger the bug.
+{-# OPTIONS_GHC -Wunused-imports #-}
+
+module T23240 ( test ) where
+import T23240_aux ( D, mkD )
+
+test :: D
+test = $$mkD
diff --git a/testsuite/tests/rename/should_compile/T23240_aux.hs b/testsuite/tests/rename/should_compile/T23240_aux.hs
new file mode 100644
index 0000000000..2ba6404efe
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T23240_aux.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE Haskell2010 #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module T23240_aux where
+
+import Language.Haskell.TH ( CodeQ )
+
+data D = MkD { myFld :: () }
+mkD :: CodeQ D
+mkD = [|| MkD { myFld = () } ||]
diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T
index 55f58fcebc..7885713c04 100644
--- a/testsuite/tests/rename/should_compile/all.T
+++ b/testsuite/tests/rename/should_compile/all.T
@@ -209,3 +209,4 @@ test('ImportNullaryRecordWildcard', [extra_files(['NullaryRecordWildcard.hs', 'N
 test('GHCINullaryRecordWildcard', combined_output, ghci_script, ['GHCINullaryRecordWildcard.script'])
 test('GHCIImplicitImportNullaryRecordWildcard', combined_output, ghci_script, ['GHCIImplicitImportNullaryRecordWildcard.script'])
 test('T22122', [expect_broken(22122), extra_files(['T22122_aux.hs'])], multimod_compile, ['T22122', '-v0'])
+test('T23240', [req_th, extra_files(['T23240_aux.hs'])], multimod_compile, ['T23240', '-v0'])