[commit: ghc] wip/T9156: Fixed issue with detection of duplicate record fields (fixes #9156) (360a6be)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T9156
Link       : http://ghc.haskell.org/trac/ghc/changeset/360a6be2b986bb6ffae67aaa5ca6d87d0e19a93e/ghc

>---------------------------------------------------------------

commit 360a6be2b986bb6ffae67aaa5ca6d87d0e19a93e
Author: Gintautas Miliauskas <gintautas.miliauskas at gmail.com>
Date:   Fri Jun 6 11:12:42 2014 +0000

    Fixed issue with detection of duplicate record fields (fixes #9156)
    
    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.


>---------------------------------------------------------------

360a6be2b986bb6ffae67aaa5ca6d87d0e19a93e
 compiler/hsSyn/HsUtils.lhs                      | 10 ++++++++--
 testsuite/tests/rename/should_compile/all.T     |  2 ++
 testsuite/tests/rename/should_compile/rn068.hs  |  3 +++
 testsuite/tests/rename/should_fail/T9156.hs     |  4 ++++
 testsuite/tests/rename/should_fail/T9156.stderr |  5 +++++
 testsuite/tests/rename/should_fail/all.T        |  1 +
 6 files changed, 23 insertions(+), 2 deletions(-)

diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs
index 42838ef..4cfdfd0 100644
--- a/compiler/hsSyn/HsUtils.lhs
+++ b/compiler/hsSyn/HsUtils.lhs
@@ -756,8 +756,14 @@ hsConDeclsBinders cons
 	where
           -- 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)
+	  new_flds = remove_seen (map cd_fld_name flds) []
+	  -- remove only the first occurrence of any seen field in order to
+	  -- avoid circumventing detection of duplicate fields (#9156)
+	  remove_seen [] _ = []
+	  remove_seen (x:xs) flds_used =
+		if unLoc x `elem` flds_seen && not (unLoc x `elem` flds_used)
+                  then remove_seen xs (unLoc x : flds_used)
+                  else x : remove_seen xs flds_used
 
     do_one (flds_seen, acc) (L loc (ConDecl { con_name = L _ name }))
 	= (flds_seen, L loc name : acc)
diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T
index 4ed92bd..d104df4 100644
--- a/testsuite/tests/rename/should_compile/all.T
+++ b/testsuite/tests/rename/should_compile/all.T
@@ -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
index 0000000..ec520e2
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/rn068.hs
@@ -0,0 +1,3 @@
+module Foo where
+
+data A = A1 { a, b :: Int } | A2 { 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
index 0000000..f4ffd1a
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T9156.hs
@@ -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
index 0000000..361ed37
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T9156.stderr
@@ -0,0 +1,5 @@
+
+T9156.hs:4:19:
+    Multiple declarations of ‘f1’
+    Declared at: T9156.hs:3:15
+                 T9156.hs:4:19
diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T
index 0f60ff6..d1bf2b6 100644
--- a/testsuite/tests/rename/should_fail/all.T
+++ b/testsuite/tests/rename/should_fail/all.T
@@ -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, [''])