Commit d2942184 authored by gintas's avatar gintas Committed by Joachim Breitner

Fixed issue with detection of duplicate record fields

Duplicate record fields would not be detected when given a type
with multiple data constructors, and the first data constructor
had a record field r1 and any consecutive data constructors
had multiple fields named r1.

This fixes #9156 and was reviewed in https://phabricator.haskell.org/D87
parent fc53ed5d
> {-# LANGUAGE ScopedTypeVariables #-}
%
% (c) The University of Glasgow, 1992-2006
%
......@@ -100,7 +102,10 @@ import FastString
import Util
import Bag
import Outputable
import Data.Either
import Data.Function
import Data.List
\end{code}
......@@ -743,24 +748,26 @@ hsDataDefnBinders (HsDataDefn { dd_cons = cons }) = hsConDeclsBinders cons
-- See Note [Binders in family instances]
-------------------
hsConDeclsBinders :: (Eq name) => [LConDecl name] -> [Located name]
hsConDeclsBinders :: forall name. (Eq name) => [LConDecl name] -> [Located name]
-- See hsLTyClDeclBinders for what this does
-- The function is boringly complicated because of the records
-- And since we only have equality, we have to be a little careful
hsConDeclsBinders cons
= snd (foldl do_one ([], []) cons)
where
do_one (flds_seen, acc) (L loc (ConDecl { con_name = L _ name
, con_details = RecCon flds }))
= (map unLoc new_flds ++ flds_seen, L loc name : new_flds ++ acc)
where
hsConDeclsBinders cons = go id cons
where go :: ([Located name] -> [Located name]) -> [LConDecl name] -> [Located name]
go _ [] = []
go remSeen (r:rs) =
-- don't re-mangle the location of field names, because we don't
-- have a record of the full location of the field declaration anyway
new_flds = filterOut (\f -> unLoc f `elem` flds_seen)
(map cd_fld_name flds)
case r of
-- remove only the first occurrence of any seen field in order to
-- avoid circumventing detection of duplicate fields (#9156)
L loc (ConDecl { con_name = L _ name , con_details = RecCon flds }) ->
(L loc name) : r' ++ go remSeen' rs
where r' = remSeen (map cd_fld_name flds)
remSeen' = foldr (.) remSeen [deleteBy ((==) `on` unLoc) v | v <- r']
L loc (ConDecl { con_name = L _ name }) ->
(L loc name) : go remSeen rs
do_one (flds_seen, acc) (L loc (ConDecl { con_name = L _ name }))
= (flds_seen, L loc name : acc)
\end{code}
Note [Binders in family instances]
......
......@@ -110,6 +110,8 @@ test('rn067',
extra_clean(['Rn067_A.hi', 'Rn067_A.o']),
multimod_compile, ['rn067', '-v0'])
test('rn068', normal, compile, [''])
test('T1972', normal, compile, [''])
test('T2205', normal, compile, [''])
......
module Foo where
data A = A1 { a, b :: Int }
| A2 { a, b :: Int }
| A3 { a, b :: Int }
module T9156 where
data D = D1 { f1 :: Int }
| D2 { f1, f1 :: Int }
T9156.hs:4:19:
Multiple declarations of ‘f1’
Declared at: T9156.hs:3:15
T9156.hs:4:19
......@@ -114,4 +114,5 @@ test('T8448', normal, compile_fail, [''])
test('T9006',
extra_clean(['T9006a.hi', 'T9006a.o']),
multimod_compile_fail, ['T9006', '-v0'])
test('T9156', normal, compile_fail, [''])
test('T9177', normal, compile_fail, [''])
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment