[commit: ghc] master: Suppress error cascade in record fields (cb76754)
git at git.haskell.org
git at git.haskell.org
Tue Oct 3 13:45:42 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/cb767542307b41c91061e743a4a4f448949b34cf/ghc
>---------------------------------------------------------------
commit cb767542307b41c91061e743a4a4f448949b34cf
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Tue Oct 3 14:42:56 2017 +0100
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.
>---------------------------------------------------------------
cb767542307b41c91061e743a4a4f448949b34cf
compiler/rename/RnPat.hs | 32 ++++++++++++++++--------
testsuite/tests/rename/should_fail/T14307.hs | 10 ++++++++
testsuite/tests/rename/should_fail/T14307.stderr | 2 ++
testsuite/tests/rename/should_fail/T2901.stderr | 4 ---
testsuite/tests/rename/should_fail/T5372.stderr | 4 ---
testsuite/tests/rename/should_fail/all.T | 1 +
6 files changed, 34 insertions(+), 19 deletions(-)
diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs
index ce8f379..2846754 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
diff --git a/testsuite/tests/rename/should_fail/T14307.hs b/testsuite/tests/rename/should_fail/T14307.hs
new file mode 100644
index 0000000..9bb33b7
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T14307.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module T14307 where
+
+data A = A { field :: Int }
+data B = B { field :: Int }
+
+f :: B -> Int
+f (C { field }) = field
diff --git a/testsuite/tests/rename/should_fail/T14307.stderr b/testsuite/tests/rename/should_fail/T14307.stderr
new file mode 100644
index 0000000..1470a40
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T14307.stderr
@@ -0,0 +1,2 @@
+
+T14307.hs:10:4: error: Not in scope: data constructor ‘C’
diff --git a/testsuite/tests/rename/should_fail/T2901.stderr b/testsuite/tests/rename/should_fail/T2901.stderr
index 2128989..d5a5bbd 100644
--- a/testsuite/tests/rename/should_fail/T2901.stderr
+++ b/testsuite/tests/rename/should_fail/T2901.stderr
@@ -2,7 +2,3 @@
T2901.hs:6:5: error:
Not in scope: data constructor ‘F.Foo’
No module named ‘F’ is imported.
-
-T2901.hs:6:13: error:
- Not in scope: ‘F.field’
- No module named ‘F’ is imported.
diff --git a/testsuite/tests/rename/should_fail/T5372.stderr b/testsuite/tests/rename/should_fail/T5372.stderr
index f6a466e..d8b8e8f 100644
--- a/testsuite/tests/rename/should_fail/T5372.stderr
+++ b/testsuite/tests/rename/should_fail/T5372.stderr
@@ -2,7 +2,3 @@
T5372.hs:4:11: error:
Not in scope: data constructor ‘MkS’
Perhaps you meant ‘T5372a.MkS’ (imported from T5372a)
-
-T5372.hs:4:17: error:
- Not in scope: ‘x’
- Perhaps you meant ‘T5372a.x’ (imported from T5372a)
diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T
index 9feee3d..b086372 100644
--- a/testsuite/tests/rename/should_fail/all.T
+++ b/testsuite/tests/rename/should_fail/all.T
@@ -129,3 +129,4 @@ test('T13644', normal, multimod_compile_fail, ['T13644','-v0'])
test('T13568', normal, multimod_compile_fail, ['T13568','-v0'])
test('T13947', normal, compile_fail, [''])
test('T13847', normal, multimod_compile_fail, ['T13847','-v0'])
+test('T14307', normal, compile_fail, [''])
More information about the ghc-commits
mailing list