diff options
author | Adam Gundry <adam@well-typed.com> | 2015-10-16 16:08:31 +0100 |
---|---|---|
committer | Adam Gundry <adam@well-typed.com> | 2015-10-16 16:27:53 +0100 |
commit | b1884b0e62f62e3c0859515c4137124ab0c9560e (patch) | |
tree | 9037ed61aeaf16b243c4b8542e3ef11f4abd7ee7 /testsuite/tests/overloadedrecflds | |
parent | 808bbdf08058785ae5bc59b5b4f2b04951d4cbbf (diff) | |
download | haskell-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')
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} |