Fixed issue with detection of duplicate record fields
authorGintautas Miliauskas <gintautas.miliauskas@gmail.com>
Thu, 24 Jul 2014 12:45:26 +0000 (14:45 +0200)
committerJoachim Breitner <mail@joachim-breitner.de>
Thu, 24 Jul 2014 12:46:32 +0000 (14:46 +0200)
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

compiler/hsSyn/HsUtils.lhs
testsuite/tests/rename/should_compile/all.T
testsuite/tests/rename/should_compile/rn068.hs [new file with mode: 0644]
testsuite/tests/rename/should_fail/T9156.hs [new file with mode: 0644]
testsuite/tests/rename/should_fail/T9156.stderr [new file with mode: 0644]
testsuite/tests/rename/should_fail/all.T

index 42838ef..e12daf4 100644 (file)
@@ -1,3 +1,5 @@
+> {-# 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]
index 4ed92bd..d104df4 100644 (file)
@@ -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, [''])
 
diff --git a/testsuite/tests/rename/should_compile/rn068.hs b/testsuite/tests/rename/should_compile/rn068.hs
new file mode 100644 (file)
index 0000000..83ed851
--- /dev/null
@@ -0,0 +1,5 @@
+module Foo where
+
+data A = A1 { a, b :: Int }
+       | A2 { a, b :: Int }
+       | A3 { a, b :: Int }
diff --git a/testsuite/tests/rename/should_fail/T9156.hs b/testsuite/tests/rename/should_fail/T9156.hs
new file mode 100644 (file)
index 0000000..f4ffd1a
--- /dev/null
@@ -0,0 +1,4 @@
+module T9156 where
+
+data D = D1 { f1 :: Int }
+       | D2 { f1, f1 :: Int }
diff --git a/testsuite/tests/rename/should_fail/T9156.stderr b/testsuite/tests/rename/should_fail/T9156.stderr
new file mode 100644 (file)
index 0000000..361ed37
--- /dev/null
@@ -0,0 +1,5 @@
+
+T9156.hs:4:19:
+    Multiple declarations of ‘f1’
+    Declared at: T9156.hs:3:15
+                 T9156.hs:4:19
index 0f60ff6..d1bf2b6 100644 (file)
@@ -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, [''])