summaryrefslogtreecommitdiff
path: root/testsuite/tests/overloadedrecflds
diff options
context:
space:
mode:
authorAdam Gundry <adam@well-typed.com>2015-10-16 16:08:31 +0100
committerAdam Gundry <adam@well-typed.com>2015-10-16 16:27:53 +0100
commitb1884b0e62f62e3c0859515c4137124ab0c9560e (patch)
tree9037ed61aeaf16b243c4b8542e3ef11f4abd7ee7 /testsuite/tests/overloadedrecflds
parent808bbdf08058785ae5bc59b5b4f2b04951d4cbbf (diff)
downloadhaskell-b1884b0e62f62e3c0859515c4137124ab0c9560e.tar.gz
Implement DuplicateRecordFields
This implements DuplicateRecordFields, the first part of the OverloadedRecordFields extension, as described at https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/DuplicateRecordFields This includes fairly wide-ranging changes in order to allow multiple records within the same module to use the same field names. Note that it does *not* allow record selector functions to be used if they are ambiguous, and it does not have any form of type-based disambiguation for selectors (but it does for updates). Subsequent parts will make overloading selectors possible using orthogonal extensions, as described on the wiki pages. This part touches quite a lot of the codebase, and requires changes to several GHC API datatypes in order to distinguish between field labels (which may be overloaded) and selector function names (which are always unique). The Haddock submodule has been adapted to compile with the GHC API changes, but it will need further work to properly support modules that use the DuplicateRecordFields extension. Test Plan: New tests added in testsuite/tests/overloadedrecflds; these will be extended once the other parts are implemented. Reviewers: goldfire, bgamari, simonpj, austin Subscribers: sjcjoosten, haggholm, mpickering, bgamari, tibbe, thomie, goldfire Differential Revision: https://phabricator.haskell.org/D761
Diffstat (limited to 'testsuite/tests/overloadedrecflds')
-rw-r--r--testsuite/tests/overloadedrecflds/Makefile3
-rw-r--r--testsuite/tests/overloadedrecflds/ghci/Makefile3
-rw-r--r--testsuite/tests/overloadedrecflds/ghci/all.T3
-rw-r--r--testsuite/tests/overloadedrecflds/ghci/overloadedrecfldsghci01.script17
-rw-r--r--testsuite/tests/overloadedrecflds/ghci/overloadedrecfldsghci01.stdout26
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/Makefile3
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail04_A.hs9
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail06_A.hs16
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail10_A.hs5
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail10_B.hs6
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail10_C.hs6
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail12_A.hs5
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/all.T22
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail01.hs19
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail01.stderr16
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail02.hs9
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail02.stderr6
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail03.hs10
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail03.stderr5
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail04.hs12
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail04.stderr11
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail05.hs10
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail05.stderr6
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.hs18
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.stderr31
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail07.hs9
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail07.stderr6
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail08.hs11
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail08.stderr5
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail09.hs11
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail09.stderr4
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail10.hs11
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail10.stderr14
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail11.hs5
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail11.stderr4
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail12.hs12
-rw-r--r--testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail12.stderr13
-rw-r--r--testsuite/tests/overloadedrecflds/should_run/Makefile3
-rw-r--r--testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun02_A.hs9
-rw-r--r--testsuite/tests/overloadedrecflds/should_run/all.T9
-rw-r--r--testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun01.hs28
-rw-r--r--testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun01.stdout1
-rw-r--r--testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun02.hs6
-rw-r--r--testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun02.stdout1
-rw-r--r--testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun03.hs25
-rw-r--r--testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun03.stdout2
-rw-r--r--testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun04.hs17
-rw-r--r--testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun04.stdout2
-rw-r--r--testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun05.hs27
-rw-r--r--testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun05.stdout4
50 files changed, 516 insertions, 0 deletions
diff --git a/testsuite/tests/overloadedrecflds/Makefile b/testsuite/tests/overloadedrecflds/Makefile
new file mode 100644
index 0000000000..9a36a1c5fe
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/Makefile
@@ -0,0 +1,3 @@
+TOP=../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/overloadedrecflds/ghci/Makefile b/testsuite/tests/overloadedrecflds/ghci/Makefile
new file mode 100644
index 0000000000..9101fbd40a
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/ghci/Makefile
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/overloadedrecflds/ghci/all.T b/testsuite/tests/overloadedrecflds/ghci/all.T
new file mode 100644
index 0000000000..013e34e730
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/ghci/all.T
@@ -0,0 +1,3 @@
+setTestOpts(when(compiler_profiled(), skip))
+
+test('overloadedrecfldsghci01', combined_output, ghci_script, ['overloadedrecfldsghci01.script'])
diff --git a/testsuite/tests/overloadedrecflds/ghci/overloadedrecfldsghci01.script b/testsuite/tests/overloadedrecflds/ghci/overloadedrecfldsghci01.script
new file mode 100644
index 0000000000..2aa0a15be8
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/ghci/overloadedrecfldsghci01.script
@@ -0,0 +1,17 @@
+
+:set -XDuplicateRecordFields
+data S = MkS { foo :: Int }
+data T a = MkT { foo :: Bool, bar :: a -> a }
+let t = MkT { foo = True, bar = id }
+(\MkT{foo=foo} -> foo) t
+:info foo
+:type foo
+foo (MkS 42)
+bar (MkT True id) True
+:set -XNoDuplicateRecordFields
+-- Should be ambiguous
+:type foo
+data U = MkU { foo :: Int }
+-- New foo should shadow the old ones
+:type foo
+foo (MkU 42)
diff --git a/testsuite/tests/overloadedrecflds/ghci/overloadedrecfldsghci01.stdout b/testsuite/tests/overloadedrecflds/ghci/overloadedrecfldsghci01.stdout
new file mode 100644
index 0000000000..3270089b9c
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/ghci/overloadedrecfldsghci01.stdout
@@ -0,0 +1,26 @@
+True
+data S = MkS {Ghci1.foo :: Int} -- Defined at <interactive>:3:16
+
+data T a = MkT {Ghci2.foo :: Bool, ...}
+ -- Defined at <interactive>:4:18
+
+<interactive>:1:1: error:
+ Ambiguous occurrence ‘foo’
+ It could refer to either the field ‘foo’,
+ defined at <interactive>:3:16
+ or the field ‘foo’, defined at <interactive>:4:18
+
+<interactive>:9:1: error:
+ Ambiguous occurrence ‘foo’
+ It could refer to either the field ‘foo’,
+ defined at <interactive>:3:16
+ or the field ‘foo’, defined at <interactive>:4:18
+True
+
+<interactive>:1:1: error:
+ Ambiguous occurrence ‘foo’
+ It could refer to either the field ‘foo’,
+ defined at <interactive>:3:16
+ or the field ‘foo’, defined at <interactive>:4:18
+foo :: U -> Int
+42
diff --git a/testsuite/tests/overloadedrecflds/should_fail/Makefile b/testsuite/tests/overloadedrecflds/should_fail/Makefile
new file mode 100644
index 0000000000..9101fbd40a
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/Makefile
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail04_A.hs b/testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail04_A.hs
new file mode 100644
index 0000000000..b9b07bdd47
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail04_A.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+
+module OverloadedRecFldsFail04_A (U(..), V(MkV, x), Unused(..), u) where
+
+data U = MkU { x :: Bool, y :: Bool }
+data V = MkV { x :: Int }
+data Unused = MkUnused { unused :: Bool }
+
+u = MkU False True
diff --git a/testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail06_A.hs b/testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail06_A.hs
new file mode 100644
index 0000000000..aaa90b9212
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail06_A.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# OPTIONS_GHC -fwarn-unused-binds #-}
+
+module OverloadedRecFldsFail06_A (U(..), V(..), Unused(unused), u, getX, getY, z) where
+
+data U = MkU { x :: Bool, y :: Bool } | MkU2 { used_locally :: Bool }
+ deriving Show
+data V = MkV { x :: Int } | MkV2 { y :: Bool }
+data Unused = MkUnused { unused :: Bool, unused2 :: Bool, used_locally :: Bool }
+
+u = MkU False True
+
+z MkU2{used_locally=used_locally} = used_locally
+
+getX MkU{x=x} = x
+getY MkV2{y=y} = y
diff --git a/testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail10_A.hs b/testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail10_A.hs
new file mode 100644
index 0000000000..923488274a
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail10_A.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE TypeFamilies #-}
+module OverloadedRecFldsFail10_A where
+
+data family F a
+data instance F Int = MkFInt { foo :: Int }
diff --git a/testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail10_B.hs b/testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail10_B.hs
new file mode 100644
index 0000000000..9cb346afe9
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail10_B.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE TypeFamilies #-}
+module OverloadedRecFldsFail10_B (F(..)) where
+
+import OverloadedRecFldsFail10_A hiding (foo)
+
+data instance F Bool = MkFBool { foo :: Int }
diff --git a/testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail10_C.hs b/testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail10_C.hs
new file mode 100644
index 0000000000..700ed2b5d6
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail10_C.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE DuplicateRecordFields, TypeFamilies #-}
+module OverloadedRecFldsFail10_C (F(..)) where
+
+import OverloadedRecFldsFail10_A
+
+data instance F Char = MkFChar { foo :: Char }
diff --git a/testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail12_A.hs b/testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail12_A.hs
new file mode 100644
index 0000000000..2c69e67b94
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail12_A.hs
@@ -0,0 +1,5 @@
+module OverloadedRecFldsFail12_A where
+
+{-# WARNING foo "Deprecated foo" #-}
+{-# WARNING bar "Deprecated bar" #-}
+data T = MkT { foo :: Int, bar :: Int }
diff --git a/testsuite/tests/overloadedrecflds/should_fail/all.T b/testsuite/tests/overloadedrecflds/should_fail/all.T
new file mode 100644
index 0000000000..fe7a85af70
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/all.T
@@ -0,0 +1,22 @@
+test('overloadedrecfldsfail01', normal, compile_fail, [''])
+test('overloadedrecfldsfail02', normal, compile_fail, [''])
+test('overloadedrecfldsfail03', normal, compile_fail, [''])
+test('overloadedrecfldsfail04',
+ extra_clean(['OverloadedRecFldsFail04_A.hi', 'OverloadedRecFldsFail04_A.o']),
+ multimod_compile_fail, ['overloadedrecfldsfail04', ''])
+test('overloadedrecfldsfail05', normal, compile_fail, [''])
+test('overloadedrecfldsfail06',
+ extra_clean(['OverloadedRecFldsFail06_A.hi', 'OverloadedRecFldsFail06_A.o']),
+ multimod_compile_fail, ['overloadedrecfldsfail06', ''])
+test('overloadedrecfldsfail07', normal, compile_fail, [''])
+test('overloadedrecfldsfail08', normal, compile_fail, [''])
+test('overloadedrecfldsfail09', normal, compile_fail, [''])
+test('overloadedrecfldsfail10',
+ extra_clean([ 'OverloadedRecFldsFail10_A.hi', 'OverloadedRecFldsFail10_A.o'
+ , 'OverloadedRecFldsFail10_B.hi', 'OverloadedRecFldsFail10_B.o'
+ , 'OverloadedRecFldsFail10_C.hi', 'OverloadedRecFldsFail10_C.o']),
+ multimod_compile_fail, ['overloadedrecfldsfail10', ''])
+test('overloadedrecfldsfail11', normal, compile_fail, [''])
+test('overloadedrecfldsfail12',
+ extra_clean(['OverloadedRecFldsFail12_A.hi', 'OverloadedRecFldsFail12_A.o']),
+ multimod_compile_fail, ['overloadedrecfldsfail12', ''])
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail01.hs b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail01.hs
new file mode 100644
index 0000000000..8ce9be7d47
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail01.hs
@@ -0,0 +1,19 @@
+-- Test ambiguous updates are rejected with appropriate error messages
+
+{-# LANGUAGE DuplicateRecordFields #-}
+
+data R = MkR { w :: Bool, x :: Int, y :: Bool }
+data S = MkS { w :: Bool, x :: Int, y :: Bool }
+data T = MkT { x :: Int, z :: Bool }
+data U = MkU { y :: Bool }
+
+-- Straightforward ambiguous update
+upd1 r = r { x = 3 }
+
+-- No type has all these fields
+upd2 r = r { x = 3, y = True, z = False }
+
+-- User-specified type does not have these fields
+upd3 r = r { w = True, x = 3, y = True } :: U
+
+main = return ()
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail01.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail01.stderr
new file mode 100644
index 0000000000..fbf8a61176
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail01.stderr
@@ -0,0 +1,16 @@
+
+overloadedrecfldsfail01.hs:11:10:
+ Record update is ambiguous, and requires a type signature
+ In the expression: r {x = 3}
+ In an equation for ‘upd1’: upd1 r = r {x = 3}
+
+overloadedrecfldsfail01.hs:14:10:
+ No type has all these fields: ‘x’, ‘y’, ‘z’
+ In the expression: r {x = 3, y = True, z = False}
+ In an equation for ‘upd2’: upd2 r = r {x = 3, y = True, z = False}
+
+overloadedrecfldsfail01.hs:17:10:
+ Type U does not have fields: ‘w’, ‘x’
+ In the expression: r {w = True, x = 3, y = True} :: U
+ In an equation for ‘upd3’:
+ upd3 r = r {w = True, x = 3, y = True} :: U
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail02.hs b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail02.hs
new file mode 100644
index 0000000000..7160438af1
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail02.hs
@@ -0,0 +1,9 @@
+-- Test selectors cannot be used ambiguously
+
+{-# LANGUAGE DuplicateRecordFields #-}
+
+data R = MkR { x :: Int, y :: Bool }
+data S = MkS { x :: Int }
+
+main = do print (x (MkS 42))
+ print (y (MkR 42 42))
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail02.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail02.stderr
new file mode 100644
index 0000000000..9c2057e17d
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail02.stderr
@@ -0,0 +1,6 @@
+
+overloadedrecfldsfail02.hs:8:18: error:
+ Ambiguous occurrence ‘x’
+ It could refer to either the field ‘x’,
+ defined at overloadedrecfldsfail02.hs:6:16
+ or the field ‘x’, defined at overloadedrecfldsfail02.hs:5:16
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail03.hs b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail03.hs
new file mode 100644
index 0000000000..9472e6a030
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail03.hs
@@ -0,0 +1,10 @@
+-- Test that a top-level definition with the same name as a record
+-- field is rejected
+
+{-# LANGUAGE DuplicateRecordFields #-}
+
+foo = True
+
+data T = MkT { foo :: Int }
+
+main = print foo
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail03.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail03.stderr
new file mode 100644
index 0000000000..4aec21c608
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail03.stderr
@@ -0,0 +1,5 @@
+
+overloadedrecfldsfail03.hs:8:16:
+ Multiple declarations of ‘foo’
+ Declared at: overloadedrecfldsfail03.hs:6:1
+ overloadedrecfldsfail03.hs:8:16
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail04.hs b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail04.hs
new file mode 100644
index 0000000000..9d35bbe5dd
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail04.hs
@@ -0,0 +1,12 @@
+-- Test that importing an overloaded field and using it as a selector
+-- leads to a suitable error
+
+{-# LANGUAGE DuplicateRecordFields #-}
+
+import OverloadedRecFldsFail04_A as I
+
+-- Qualified overloaded fields are not allowed here
+x' = I.x
+
+-- But this is okay
+f e = e { I.x = True, I.y = False }
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail04.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail04.stderr
new file mode 100644
index 0000000000..579735470c
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail04.stderr
@@ -0,0 +1,11 @@
+[1 of 2] Compiling OverloadedRecFldsFail04_A ( OverloadedRecFldsFail04_A.hs, OverloadedRecFldsFail04_A.o )
+[2 of 2] Compiling Main ( overloadedrecfldsfail04.hs, overloadedrecfldsfail04.o )
+
+overloadedrecfldsfail04.hs:9:6:
+ Ambiguous occurrence ‘I.x’
+ It could refer to either the field ‘x’,
+ imported from ‘OverloadedRecFldsFail04_A’ at overloadedrecfldsfail04.hs:6:1-37
+ (and originally defined at OverloadedRecFldsFail04_A.hs:6:16)
+ or the field ‘x’,
+ imported from ‘OverloadedRecFldsFail04_A’ at overloadedrecfldsfail04.hs:6:1-37
+ (and originally defined at OverloadedRecFldsFail04_A.hs:5:16)
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail05.hs b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail05.hs
new file mode 100644
index 0000000000..f7f0374a17
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail05.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# OPTIONS_GHC -fwarn-unused-binds -Werror #-}
+
+module Main (main, T(MkT)) where
+
+data S = MkS { foo :: Int }
+data T = MkT { foo :: Int }
+
+-- This should count as a use of S(foo) but not T(foo)
+main = print ((\ MkS{foo=foo} -> foo) (MkS 3))
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail05.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail05.stderr
new file mode 100644
index 0000000000..687d6d6eda
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail05.stderr
@@ -0,0 +1,6 @@
+
+overloadedrecfldsfail05.hs:7:16: warning:
+ Defined but not used: ‘foo’
+
+<no location info>: error:
+Failing due to -Werror.
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.hs b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.hs
new file mode 100644
index 0000000000..249cb5693a
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.hs
@@ -0,0 +1,18 @@
+-- Check that unused imports are reported correctly in the presence of
+-- DuplicateRecordFields
+
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# OPTIONS_GHC -Werror -fwarn-unused-imports #-}
+
+import OverloadedRecFldsFail06_A (U(x, y), V(MkV, MkV2, x, y), Unused(unused), u, getY)
+import qualified OverloadedRecFldsFail06_A as M (U(x))
+import qualified OverloadedRecFldsFail06_A as N (V(x, y))
+import qualified OverloadedRecFldsFail06_A as P (U(x), V(x))
+
+v = MkV2 True
+
+-- Check that this counts a use of U(x) and V(y) but not U(y) or V(x)...
+main = do print (u { x = True } :: U)
+ print ((\ MkV2{y=y} -> y) v)
+ print (N.x v)
+ print (getY (v { P.x = 3 }))
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.stderr
new file mode 100644
index 0000000000..6a1b939a55
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.stderr
@@ -0,0 +1,31 @@
+[1 of 2] Compiling OverloadedRecFldsFail06_A ( OverloadedRecFldsFail06_A.hs, OverloadedRecFldsFail06_A.o )
+
+OverloadedRecFldsFail06_A.hs:9:15: warning:
+ Defined but not used: data constructor ‘MkUnused’
+
+OverloadedRecFldsFail06_A.hs:9:42: warning:
+ Defined but not used: ‘unused2’
+
+OverloadedRecFldsFail06_A.hs:9:59: warning:
+ Defined but not used: ‘used_locally’
+[2 of 2] Compiling Main ( overloadedrecfldsfail06.hs, overloadedrecfldsfail06.o )
+
+overloadedrecfldsfail06.hs:7:1: warning:
+ The import of ‘Unused(unused), V(x), U(y), MkV, Unused’
+ from module ‘OverloadedRecFldsFail06_A’ is redundant
+
+overloadedrecfldsfail06.hs:8:1: warning:
+ The qualified import of ‘OverloadedRecFldsFail06_A’ is redundant
+ except perhaps to import instances from ‘OverloadedRecFldsFail06_A’
+ To import instances alone, use: import OverloadedRecFldsFail06_A()
+
+overloadedrecfldsfail06.hs:9:1: warning:
+ The qualified import of ‘V(y)’
+ from module ‘OverloadedRecFldsFail06_A’ is redundant
+
+overloadedrecfldsfail06.hs:10:1: warning:
+ The qualified import of ‘U(x), U’
+ from module ‘OverloadedRecFldsFail06_A’ is redundant
+
+<no location info>: error:
+Failing due to -Werror.
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail07.hs b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail07.hs
new file mode 100644
index 0000000000..c3a7d24bb4
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail07.hs
@@ -0,0 +1,9 @@
+-- Test type errors contain field names, not selector names
+
+{-# LANGUAGE DuplicateRecordFields #-}
+
+data T = MkT { x :: Int }
+
+y = x x
+
+main = return ()
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail07.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail07.stderr
new file mode 100644
index 0000000000..87de242e4b
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail07.stderr
@@ -0,0 +1,6 @@
+
+overloadedrecfldsfail07.hs:7:7:
+ Couldn't match expected type ‘T’ with actual type ‘T -> Int’
+ Probable cause: ‘x’ is applied to too few arguments
+ In the first argument of ‘x’, namely ‘x’
+ In the expression: x x
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail08.hs b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail08.hs
new file mode 100644
index 0000000000..993ff67329
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail08.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE DuplicateRecordFields, TypeFamilies #-}
+
+data family F a
+data instance F Int = MkFInt { x :: Int }
+data instance F Bool = MkFBool { y :: Bool }
+
+-- No data type has both these fields, but they belong to the same
+-- lexical parent (F). This used to confuse DuplicateRecordFields.
+foo e = e { x = 3, y = True }
+
+main = return ()
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail08.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail08.stderr
new file mode 100644
index 0000000000..cf37520a64
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail08.stderr
@@ -0,0 +1,5 @@
+
+overloadedrecfldsfail08.hs:9:9: error:
+ No constructor has all these fields: ‘x’, ‘y’
+ In the expression: e {x = 3, y = True}
+ In an equation for ‘foo’: foo e = e {x = 3, y = True}
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail09.hs b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail09.hs
new file mode 100644
index 0000000000..40d82bb7a2
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail09.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE DuplicateRecordFields, TemplateHaskell #-}
+
+data S = MkS { x :: Int }
+data T = MkT { x :: Int }
+
+-- This tests what happens when an ambiguous record update is used in
+-- a splice: since it can't be represented in TH, it should error
+-- cleanly, rather than panicking or silently using one field.
+foo = [e| (MkS 3) { x = 3 } |]
+
+main = return ()
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail09.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail09.stderr
new file mode 100644
index 0000000000..8d892e380a
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail09.stderr
@@ -0,0 +1,4 @@
+
+overloadedrecfldsfail09.hs:9:11: error:
+ ambiguous record updates not (yet) handled by Template Haskell
+ x = 3
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail10.hs b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail10.hs
new file mode 100644
index 0000000000..ccb25d3387
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail10.hs
@@ -0,0 +1,11 @@
+-- Modules A and B both declare F(foo)
+-- Module C declares F($sel:foo:MkFChar) but exports A.F(foo) as well
+-- Thus we can't export F(..) even with DuplicateRecordFields enabled
+
+{-# LANGUAGE DuplicateRecordFields #-}
+module Main (main, F(..)) where
+
+import OverloadedRecFldsFail10_B
+import OverloadedRecFldsFail10_C
+
+main = return ()
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail10.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail10.stderr
new file mode 100644
index 0000000000..9d8e8bd6c3
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail10.stderr
@@ -0,0 +1,14 @@
+[1 of 4] Compiling OverloadedRecFldsFail10_A ( OverloadedRecFldsFail10_A.hs, OverloadedRecFldsFail10_A.o )
+[2 of 4] Compiling OverloadedRecFldsFail10_C ( OverloadedRecFldsFail10_C.hs, OverloadedRecFldsFail10_C.o )
+[3 of 4] Compiling OverloadedRecFldsFail10_B ( OverloadedRecFldsFail10_B.hs, OverloadedRecFldsFail10_B.o )
+[4 of 4] Compiling Main ( overloadedrecfldsfail10.hs, overloadedrecfldsfail10.o )
+
+overloadedrecfldsfail10.hs:6:20: error:
+ Conflicting exports for ‘foo’:
+ ‘F(..)’ exports ‘OverloadedRecFldsFail10_B.foo’
+ imported from ‘OverloadedRecFldsFail10_B’ at overloadedrecfldsfail10.hs:8:1-32
+ (and originally defined at OverloadedRecFldsFail10_B.hs:6:34-36)
+ ‘F(..)’ exports ‘OverloadedRecFldsFail10_C.foo’
+ imported from ‘OverloadedRecFldsFail10_C’ at overloadedrecfldsfail10.hs:9:1-32
+ (and originally defined in ‘OverloadedRecFldsFail10_A’
+ at OverloadedRecFldsFail10_A.hs:5:32-34)
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail11.hs b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail11.hs
new file mode 100644
index 0000000000..9c5c145c94
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail11.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+
+{-# WARNING foo "No warnings for DRFs" #-}
+data S = MkS { foo :: Bool }
+data T = MkT { foo :: Int }
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail11.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail11.stderr
new file mode 100644
index 0000000000..650456ccd0
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail11.stderr
@@ -0,0 +1,4 @@
+
+overloadedrecfldsfail11.hs:3:13: error:
+ The deprecation for ‘foo’ lacks an accompanying binding
+ (The deprecation must be given where ‘foo’ is declared)
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail12.hs b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail12.hs
new file mode 100644
index 0000000000..0516e43d63
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail12.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# OPTIONS_GHC -Werror #-}
+
+import OverloadedRecFldsFail12_A
+
+data S = MkS { foo :: Bool }
+
+-- Use of foo and bar should give deprecation warnings
+f :: T -> T
+f e = e { foo = 3, bar = 3 }
+
+main = return ()
diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail12.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail12.stderr
new file mode 100644
index 0000000000..65733ed6e8
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail12.stderr
@@ -0,0 +1,13 @@
+[1 of 2] Compiling OverloadedRecFldsFail12_A ( OverloadedRecFldsFail12_A.hs, OverloadedRecFldsFail12_A.o )
+[2 of 2] Compiling Main ( overloadedrecfldsfail12.hs, overloadedrecfldsfail12.o )
+
+overloadedrecfldsfail12.hs:10:11: warning:
+ In the use of ‘foo’ (imported from OverloadedRecFldsFail12_A):
+ "Deprecated foo"
+
+overloadedrecfldsfail12.hs:10:20: warning:
+ In the use of ‘bar’ (imported from OverloadedRecFldsFail12_A):
+ "Deprecated bar"
+
+<no location info>: error:
+Failing due to -Werror.
diff --git a/testsuite/tests/overloadedrecflds/should_run/Makefile b/testsuite/tests/overloadedrecflds/should_run/Makefile
new file mode 100644
index 0000000000..9101fbd40a
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_run/Makefile
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun02_A.hs b/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun02_A.hs
new file mode 100644
index 0000000000..825942550b
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun02_A.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+
+module OverloadedRecFldsRun02_A (U(..), V(MkV, x), Unused(..), u) where
+
+data U = MkU { x :: Bool, y :: Bool }
+data V = MkV { x :: Int }
+data Unused = MkUnused { unused :: Bool }
+
+u = MkU False True
diff --git a/testsuite/tests/overloadedrecflds/should_run/all.T b/testsuite/tests/overloadedrecflds/should_run/all.T
new file mode 100644
index 0000000000..012916ab6a
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_run/all.T
@@ -0,0 +1,9 @@
+test('overloadedrecfldsrun01',
+ extra_clean(['OverloadedRecFldsRun01_A.hi', 'OverloadedRecFldsRun01_A.o']),
+ multimod_compile_and_run, ['overloadedrecfldsrun01', ''])
+test('overloadedrecfldsrun02',
+ extra_clean(['OverloadedRecFldsRun02_A.hi', 'OverloadedRecFldsRun02_A.o']),
+ multimod_compile_and_run, ['overloadedrecfldsrun02', ''])
+test('overloadedrecfldsrun03', normal, compile_and_run, [''])
+test('overloadedrecfldsrun04', normal, compile_and_run, [''])
+test('overloadedrecfldsrun05', normal, compile_and_run, [''])
diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun01.hs b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun01.hs
new file mode 100644
index 0000000000..dac3749960
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun01.hs
@@ -0,0 +1,28 @@
+-- Test that unambiguous constructions remain valid when
+-- DuplicateRecordFields is enabled
+
+{-# LANGUAGE DuplicateRecordFields #-}
+
+data S = MkS { x :: Int }
+ deriving Show
+
+data T = MkT { x :: Bool, y :: Bool -> Bool, tField :: Bool }
+
+data U a = MkU { x :: a, y :: a }
+
+-- Construction is unambiguous
+s = MkS { x = 42 }
+t = MkT { x = True, y = id, tField = False }
+
+-- Pattern matching is unambiguous
+get_x MkS{x=x} = x
+
+-- Resolving ambiguous monomorphic updates
+a = t { x = False, y = not, tField = True } -- only T has all these fields
+b = s { x = 3 } :: S -- type being pushed in
+c = (t :: T) { x = False } -- type signature on record expression
+
+-- Unambiguous selectors are in scope normally
+z = tField t
+
+main = print (get_x b)
diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun01.stdout b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun01.stdout
new file mode 100644
index 0000000000..00750edc07
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun01.stdout
@@ -0,0 +1 @@
+3
diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun02.hs b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun02.hs
new file mode 100644
index 0000000000..7140316f5c
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun02.hs
@@ -0,0 +1,6 @@
+-- This module does not enable -XDuplicateRecordFields, but it should
+-- still be able to refer to non-overloaded fields like `y`
+
+import OverloadedRecFldsRun02_A
+
+main = print (y u)
diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun02.stdout b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun02.stdout
new file mode 100644
index 0000000000..0ca95142bb
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun02.stdout
@@ -0,0 +1 @@
+True
diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun03.hs b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun03.hs
new file mode 100644
index 0000000000..03a4535413
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun03.hs
@@ -0,0 +1,25 @@
+-- Test that DuplicateRecordFields can be used along with
+-- TypeFamilies (with selectors only if unambiguous)
+
+{-# LANGUAGE DuplicateRecordFields, TypeFamilies #-}
+
+data family F a
+
+data instance F Int = MkFInt { foo :: Int }
+data instance F Bool = MkFBool { bar :: Bool, baz :: Bool }
+
+
+data family G a
+
+data instance G Int = MkGInt { foo :: Int }
+data instance G Bool = MkGBool { bar :: Bool }
+
+x = MkFBool { bar = False, baz = True }
+
+y :: F Bool
+y = x { bar = True }
+
+get_bar MkFBool{bar=bar} = bar
+
+main = do print (baz y)
+ print (get_bar y)
diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun03.stdout b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun03.stdout
new file mode 100644
index 0000000000..dbde422651
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun03.stdout
@@ -0,0 +1,2 @@
+True
+True
diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun04.hs b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun04.hs
new file mode 100644
index 0000000000..ed26e0f984
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun04.hs
@@ -0,0 +1,17 @@
+-- Test that DuplicateRecordFields works with TemplateHaskell
+
+{-# LANGUAGE DuplicateRecordFields, TemplateHaskell #-}
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+
+-- Splice in a datatype with field...
+$(return [DataD [] (mkName "R") [] [RecC (mkName "MkR") [(mkName "foo", NotStrict, ConT ''Int)]] []])
+
+-- New TH story means reify only sees R if we do this:
+$(return [])
+
+-- ... and check that we can inspect it
+main = do putStrLn $(do { info <- reify ''R
+ ; lift (pprint info) })
+ print (foo (MkR { foo = 42 }))
diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun04.stdout b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun04.stdout
new file mode 100644
index 0000000000..1dbffc722b
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun04.stdout
@@ -0,0 +1,2 @@
+data Main.R = Main.MkR {Main.$sel:foo:MkR :: GHC.Types.Int}
+42
diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun05.hs b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun05.hs
new file mode 100644
index 0000000000..49d8c2041d
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun05.hs
@@ -0,0 +1,27 @@
+-- Test that DuplicateRecordFields works with NamedFieldPuns and
+-- RecordWildCards
+
+{-# LANGUAGE DuplicateRecordFields, NamedFieldPuns, RecordWildCards #-}
+
+data S = MkS { foo :: Int }
+ deriving Show
+data T = MkT { foo :: Int }
+ deriving Show
+
+f MkS{foo} = MkT{foo}
+
+g MkT{..} = MkS{..}
+
+h e = let foo = 6 in e { foo } :: S
+
+main = do print a
+ print b
+ print c
+ print d
+ where
+ foo = 42
+
+ a = MkS{foo}
+ b = f a
+ c = g b
+ d = h c
diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun05.stdout b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun05.stdout
new file mode 100644
index 0000000000..d7796b88b6
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun05.stdout
@@ -0,0 +1,4 @@
+MkS {foo = 42}
+MkT {foo = 42}
+MkS {foo = 42}
+MkS {foo = 6}