Suppress error cascade in record fields

When a record contruction or pattern uses a data constructor
that isn't in scope, we may produce spurious ambiguous-field
errors (Trac #14307).  E.g.

   f (A { fld = x }) = e

where 'A' is not in scope.  We want to draw attention to the
out-of-scope data constructor first; once that is fixed we
can think about the fields.

This patch suppresses the field errors if the data con is out
of scope.

1 files changed, 21 insertions, 11 deletions

diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs
index ce8f3793ad..2846754f11 100644
--- a/compiler/rename/RnPat.hs
+++ b/compiler/rename/RnPat.hs
@@ -51,6 +51,7 @@ import RnUtils             ( HsDocContext(..), newLocalBndrRn, bindLocalNames
                            , warnUnusedMatches, newLocalBndrRn
                            , checkDupNames, checkDupAndShadowedNames
                            , checkTupSize , unknownSubordinateErr )
+import RnUnbound           ( mkUnboundName )
 import RnTypes
 import PrelNames
 import TyCon               ( tyConName )
@@ -58,6 +59,7 @@ import ConLike
 import Type                ( TyThing(..) )
 import Name
 import NameSet
+import OccName             ( setOccNameSpace, tcName )
 import RdrName
 import BasicTypes
 import Util
@@ -589,13 +591,9 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
        ; return (all_flds, mkFVs (getFieldIds all_flds)) }
   where
     mb_con = case ctxt of
-                HsRecFieldCon con | not (isUnboundName con) -> Just con
-                HsRecFieldPat con | not (isUnboundName con) -> Just con
-                _ {- update or isUnboundName con -}         -> Nothing
-           -- The unbound name test is because if the constructor
-           -- isn't in scope the constructor lookup will add an error
-           -- add an error, but still return an unbound name.
-           -- We don't want that to screw up the dot-dot fill-in stuff.
+                HsRecFieldCon con  -> Just con
+                HsRecFieldPat con  -> Just con
+                _ {- update -}     -> Nothing
 
     doc = case mb_con of
             Nothing  -> text "constructor field name"
@@ -624,11 +622,11 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
                                 --    out of scope constructor)
               -> [LHsRecField GhcRn (Located arg)] -- Explicit fields
               -> RnM [LHsRecField GhcRn (Located arg)]   -- Filled in .. fields
-    rn_dotdot Nothing _mb_con _flds     -- No ".." at all
-      = return []
-    rn_dotdot (Just {}) Nothing _flds   -- Constructor out of scope
-      = return []
     rn_dotdot (Just n) (Just con) flds -- ".." on record construction / pat match
+      | not (isUnboundName con) -- This test is because if the constructor
+                                -- isn't in scope the constructor lookup will add
+                                -- an error but still return an unbound name. We
+                                -- don't want that to screw up the dot-dot fill-in stuff.
       = ASSERT( flds `lengthIs` n )
         do { loc <- getSrcSpanM -- Rather approximate
            ; dd_flag <- xoptM LangExt.RecordWildCards
@@ -665,6 +663,12 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
                     , let sel     = flSelector fl
                     , let arg_rdr = mkVarUnqual (flLabel fl) ] }
 
+    rn_dotdot _dotdot _mb_con _flds
+      = return []
+      -- _dotdot = Nothing => No ".." at all
+      -- _mb_con = Nothing => Record update
+      -- _mb_con = Just unbound => Out of scope data constructor
+
     check_disambiguation :: Bool -> Maybe Name -> RnM (Maybe Name)
     -- When disambiguation is on, return name of parent tycon.
     check_disambiguation disambig_ok mb_con
@@ -679,6 +683,12 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
     -- or 'Nothing' if it is a pattern synonym or not in scope.
     -- That's the parent to use for looking up record fields.
     find_tycon env con_name
+      | isUnboundName con_name
+      = Just (mkUnboundName (setOccNameSpace tcName (getOccName con_name)))
+        -- If the data con is not in scope, return an unboundName tycon
+        -- That way the calls to lookupRecFieldOcc in rn_fld won't generate
+        -- an error cascade; see Trac #14307
+
       | Just (AConLike (RealDataCon dc)) <- wiredInNameTyThing_maybe con_name
       = Just (tyConName (dataConTyCon dc))
         -- Special case for [], which is built-in syntax