From c975175efcf733062c2e3fb1821dbf72f466b031 Mon Sep 17 00:00:00 2001 From: Adam Gundry Date: Sat, 18 Oct 2014 17:29:12 +0100 Subject: ghc: implement OverloadedRecordFields This fully implements the new ORF extension, developed during the Google Summer of Code 2013, and as described on the wiki: https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields This also updates the Haddock submodule. --- testsuite/tests/driver/T4437.hs | 1 + testsuite/tests/ghci/scripts/ghci042.stdout | 2 +- testsuite/tests/module/mod176.stderr | 2 +- testsuite/tests/overloadedrecflds/Makefile | 3 + testsuite/tests/overloadedrecflds/ghci/Makefile | 3 + testsuite/tests/overloadedrecflds/ghci/all.T | 3 + .../ghci/overloadedrecfldsghci01.script | 13 ++++ .../ghci/overloadedrecfldsghci01.stdout | 11 ++++ .../tests/overloadedrecflds/should_fail/Makefile | 3 + .../should_fail/OverloadedRecFldsFail04_A.hs | 9 +++ .../should_fail/OverloadedRecFldsFail06_A.hs | 16 +++++ .../should_fail/OverloadedRecFldsFail08_A.hs | 14 +++++ .../tests/overloadedrecflds/should_fail/all.T | 16 +++++ .../should_fail/overloadedrecfldsfail01.hs | 17 ++++++ .../should_fail/overloadedrecfldsfail01.stderr | 16 +++++ .../should_fail/overloadedrecfldsfail02.hs | 19 ++++++ .../should_fail/overloadedrecfldsfail02.stderr | 50 ++++++++++++++++ .../should_fail/overloadedrecfldsfail03.hs | 7 +++ .../should_fail/overloadedrecfldsfail03.stderr | 5 ++ .../should_fail/overloadedrecfldsfail04.hs | 9 +++ .../should_fail/overloadedrecfldsfail04.stderr | 5 ++ .../should_fail/overloadedrecfldsfail05.hs | 10 ++++ .../should_fail/overloadedrecfldsfail05.stderr | 10 ++++ .../should_fail/overloadedrecfldsfail06.hs | 10 ++++ .../should_fail/overloadedrecfldsfail06.stderr | 15 +++++ .../should_fail/overloadedrecfldsfail07.hs | 11 ++++ .../should_fail/overloadedrecfldsfail07.stderr | 6 ++ .../should_fail/overloadedrecfldsfail08.hs | 13 ++++ .../should_fail/overloadedrecfldsfail08.stderr | 47 +++++++++++++++ .../should_fail/overloadedrecfldsfail09.hs | 9 +++ .../should_fail/overloadedrecfldsfail09.stderr | 20 +++++++ .../should_fail/overloadedrecfldsfail10.hs | 11 ++++ .../should_fail/overloadedrecfldsfail10.stderr | 9 +++ .../tests/overloadedrecflds/should_run/Makefile | 3 + .../should_run/OverloadedRecFldsRun01_A.hs | 9 +++ .../should_run/OverloadedRecFldsRun02_A.hs | 9 +++ .../should_run/OverloadedRecFldsRun07_A.hs | 11 ++++ .../should_run/OverloadedRecFldsRun07_B.hs | 7 +++ .../should_run/OverloadedRecFldsRun08_A.hs | 11 ++++ .../should_run/OverloadedRecFldsRun08_B.hs | 7 +++ .../should_run/OverloadedRecFldsRun08_C.hs | 7 +++ .../should_run/OverloadedRecFldsRun11_A.hs | 9 +++ .../should_run/OverloadedRecFldsRun11_A.hs-boot | 5 ++ .../should_run/OverloadedRecFldsRun11_B.hs | 7 +++ .../should_run/OverloadedRecFldsRun12_A.hs | 11 ++++ .../should_run/OverloadedRecFldsRun12_B.hs | 7 +++ testsuite/tests/overloadedrecflds/should_run/all.T | 26 ++++++++ .../should_run/overloadedrecfldsrun01.hs | 70 ++++++++++++++++++++++ .../should_run/overloadedrecfldsrun01.stdout | 13 ++++ .../should_run/overloadedrecfldsrun02.hs | 6 ++ .../should_run/overloadedrecfldsrun02.stdout | 1 + .../should_run/overloadedrecfldsrun03.hs | 18 ++++++ .../should_run/overloadedrecfldsrun03.stdout | 4 ++ .../should_run/overloadedrecfldsrun04.hs | 18 ++++++ .../should_run/overloadedrecfldsrun04.stdout | 3 + .../should_run/overloadedrecfldsrun05.hs | 34 +++++++++++ .../should_run/overloadedrecfldsrun05.stdout | 2 + .../should_run/overloadedrecfldsrun06.hs | 28 +++++++++ .../should_run/overloadedrecfldsrun06.stdout | 1 + .../should_run/overloadedrecfldsrun07.hs | 7 +++ .../should_run/overloadedrecfldsrun07.stdout | 3 + .../should_run/overloadedrecfldsrun08.hs | 7 +++ .../should_run/overloadedrecfldsrun08.stdout | 2 + .../should_run/overloadedrecfldsrun09.hs | 8 +++ .../should_run/overloadedrecfldsrun09.stdout | 2 + .../should_run/overloadedrecfldsrun10.hs | 12 ++++ .../should_run/overloadedrecfldsrun10.stderr | 2 + .../should_run/overloadedrecfldsrun11.hs | 5 ++ .../should_run/overloadedrecfldsrun11.stdout | 1 + .../should_run/overloadedrecfldsrun12.hs | 6 ++ .../should_run/overloadedrecfldsrun12.stdout | 2 + .../should_run/overloadedrecfldsrun13.hs | 9 +++ .../should_run/overloadedrecfldsrun13.stdout | 1 + testsuite/tests/rename/should_fail/T5892a.stderr | 2 +- .../tests/typecheck/should_fail/tcfail102.stderr | 3 +- 75 files changed, 790 insertions(+), 4 deletions(-) create mode 100644 testsuite/tests/overloadedrecflds/Makefile create mode 100644 testsuite/tests/overloadedrecflds/ghci/Makefile create mode 100644 testsuite/tests/overloadedrecflds/ghci/all.T create mode 100644 testsuite/tests/overloadedrecflds/ghci/overloadedrecfldsghci01.script create mode 100644 testsuite/tests/overloadedrecflds/ghci/overloadedrecfldsghci01.stdout create mode 100644 testsuite/tests/overloadedrecflds/should_fail/Makefile create mode 100644 testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail04_A.hs create mode 100644 testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail06_A.hs create mode 100644 testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail08_A.hs create mode 100644 testsuite/tests/overloadedrecflds/should_fail/all.T create mode 100644 testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail01.hs create mode 100644 testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail01.stderr create mode 100644 testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail02.hs create mode 100644 testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail02.stderr create mode 100644 testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail03.hs create mode 100644 testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail03.stderr create mode 100644 testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail04.hs create mode 100644 testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail04.stderr create mode 100644 testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail05.hs create mode 100644 testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail05.stderr create mode 100644 testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.hs create mode 100644 testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.stderr create mode 100644 testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail07.hs create mode 100644 testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail07.stderr create mode 100644 testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail08.hs create mode 100644 testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail08.stderr create mode 100644 testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail09.hs create mode 100644 testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail09.stderr create mode 100644 testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail10.hs create mode 100644 testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail10.stderr create mode 100644 testsuite/tests/overloadedrecflds/should_run/Makefile create mode 100644 testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun01_A.hs create mode 100644 testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun02_A.hs create mode 100644 testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun07_A.hs create mode 100644 testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun07_B.hs create mode 100644 testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun08_A.hs create mode 100644 testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun08_B.hs create mode 100644 testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun08_C.hs create mode 100644 testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun11_A.hs create mode 100644 testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun11_A.hs-boot create mode 100644 testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun11_B.hs create mode 100644 testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun12_A.hs create mode 100644 testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun12_B.hs create mode 100644 testsuite/tests/overloadedrecflds/should_run/all.T create mode 100644 testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun01.hs create mode 100644 testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun01.stdout create mode 100644 testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun02.hs create mode 100644 testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun02.stdout create mode 100644 testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun03.hs create mode 100644 testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun03.stdout create mode 100644 testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun04.hs create mode 100644 testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun04.stdout create mode 100644 testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun05.hs create mode 100644 testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun05.stdout create mode 100644 testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun06.hs create mode 100644 testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun06.stdout create mode 100644 testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun07.hs create mode 100644 testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun07.stdout create mode 100644 testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun08.hs create mode 100644 testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun08.stdout create mode 100644 testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun09.hs create mode 100644 testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun09.stdout create mode 100644 testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun10.hs create mode 100644 testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun10.stderr create mode 100644 testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun11.hs create mode 100644 testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun11.stdout create mode 100644 testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun12.hs create mode 100644 testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun12.stdout create mode 100644 testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun13.hs create mode 100644 testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun13.stdout (limited to 'testsuite') diff --git a/testsuite/tests/driver/T4437.hs b/testsuite/tests/driver/T4437.hs index 40ddb4b66b..b201b563d7 100644 --- a/testsuite/tests/driver/T4437.hs +++ b/testsuite/tests/driver/T4437.hs @@ -33,6 +33,7 @@ expectedGhcOnlyExtensions :: [String] expectedGhcOnlyExtensions = ["RelaxedLayout", "AlternativeLayoutRule", "AlternativeLayoutRuleTransitional", + "OverloadedRecordFields", "JavaScriptFFI", "PatternSynonyms"] diff --git a/testsuite/tests/ghci/scripts/ghci042.stdout b/testsuite/tests/ghci/scripts/ghci042.stdout index 2a75ecb496..7a519f6671 100644 --- a/testsuite/tests/ghci/scripts/ghci042.stdout +++ b/testsuite/tests/ghci/scripts/ghci042.stdout @@ -3,4 +3,4 @@ data T = A {a :: Int} -- Defined at :3:13 a :: Integer -- Defined at :6:5 3 data R = B {a :: Int} -- Defined at :9:13 -data T = A {Ghci1.a :: Int} -- Defined at :3:1 +data T = A {a :: Int} -- Defined at :3:1 diff --git a/testsuite/tests/module/mod176.stderr b/testsuite/tests/module/mod176.stderr index 5b8c71b0dd..d69ba608f6 100644 --- a/testsuite/tests/module/mod176.stderr +++ b/testsuite/tests/module/mod176.stderr @@ -1,4 +1,4 @@ mod176.hs:4:1: Warning: - The import of ‘return, Monad’ + The import of ‘Monad, return’ from module ‘Control.Monad’ is redundant 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..05acd82962 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/ghci/overloadedrecfldsghci01.script @@ -0,0 +1,13 @@ +:set -XOverloadedRecordFields +data S = MkS { foo :: Int } +data T a = MkT { foo :: Bool, bar :: a -> a } +:type foo +foo (MkS 42) +foo (MkT True id) +:set -XNoOverloadedRecordFields +-- 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..d2bc839c33 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/ghci/overloadedrecfldsghci01.stdout @@ -0,0 +1,11 @@ +foo :: GHC.Records.Accessor t t1 "foo" t2 => t t1 t2 +42 +True + +:1:1: + Ambiguous occurrence ‘foo’ + It could refer to either the field ‘foo’, + defined at :4:18 + or the field ‘foo’, defined at :3:16 +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..e4c638e751 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail04_A.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE OverloadedRecordFields #-} + +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..bc848629a9 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail06_A.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE OverloadedRecordFields #-} +{-# 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 r = used_locally r + +getX r = x r +getY r = y r diff --git a/testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail08_A.hs b/testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail08_A.hs new file mode 100644 index 0000000000..aa830cc8be --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/OverloadedRecFldsFail08_A.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE OverloadedRecordFields, ExistentialQuantification, RankNTypes, TypeFamilies #-} + +module OverloadedRecFldsFail08_A where + +-- x is existential (naughty) +data T = forall e . MkT { x :: e } + +-- y and z are higher-rank +data U = MkU { y :: forall a . a -> a } + | MkU2 { z :: (forall b . b) -> () } + +data family F a +data instance F Int = forall e . MkFInt { foo :: e } +data instance F Bool = MkFBool { foo :: forall a . a -> a } diff --git a/testsuite/tests/overloadedrecflds/should_fail/all.T b/testsuite/tests/overloadedrecflds/should_fail/all.T new file mode 100644 index 0000000000..111eff01af --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/all.T @@ -0,0 +1,16 @@ +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', skip, compile_fail, ['']) +test('overloadedrecfldsfail08', + extra_clean(['OverloadedRecFldsFail08_A.hi', 'OverloadedRecFldsFail08_A.o']), + multimod_compile_fail, ['overloadedrecfldsfail08', '']) +test('overloadedrecfldsfail09', normal, compile_fail, ['']) +test('overloadedrecfldsfail10', normal, compile_fail, ['']) diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail01.hs b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail01.hs new file mode 100644 index 0000000000..0087237d9d --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail01.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE OverloadedRecordFields #-} + +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 () \ No newline at end of file diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail01.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail01.stderr new file mode 100644 index 0000000000..3a440a838e --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail01.stderr @@ -0,0 +1,16 @@ + +overloadedrecfldsfail01.hs:9: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:12: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:15: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..9d0a9e3776 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail02.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE OverloadedRecordFields, ExistentialQuantification, RankNTypes #-} + +-- x is existential (naughty) +data T a = forall e . MkT { x :: e } + +-- x and y are higher-rank +data U = MkU { x :: forall a . a -> a } + | MkU2 { y :: (forall b . b) -> () } + +-- Should generate sensible unsolved constraint errors +a = x (MkT True) :: Bool +b = x (MkU id) +c = y (MkU2 (\ _ -> ())) +d = x ((\ x -> x) :: Int -> Int) :: Bool + +e :: (T Int) { foo :: t } => t +e = x (MkT True) + +main = return () diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail02.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail02.stderr new file mode 100644 index 0000000000..013c2231e7 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail02.stderr @@ -0,0 +1,50 @@ + +overloadedrecfldsfail02.hs:11:5: + No instance for (T a1) {x :: Bool} + arising from a use of the record selector ‘x’ + The field ‘x’ of ‘T’ cannot be overloaded, + as its type is existentially quantified + In the expression: x + In the expression: x (MkT True) :: Bool + In an equation for ‘a’: a = x (MkT True) :: Bool + +overloadedrecfldsfail02.hs:12:5: + No instance for U {x :: ...} + arising from a use of the record selector ‘x’ + The field ‘x’ of ‘U’ cannot be overloaded, + as its type is universally quantified + In the expression: x + In the expression: x (MkU id) + In an equation for ‘b’: b = x (MkU id) + +overloadedrecfldsfail02.hs:13:5: + No instance for U {y :: ...} + arising from a use of the record selector ‘y’ + The field ‘y’ of ‘U’ cannot be overloaded, + as its type is universally quantified + In the expression: y + In the expression: y (MkU2 (\ _ -> ())) + In an equation for ‘c’: c = y (MkU2 (\ _ -> ())) + +overloadedrecfldsfail02.hs:14:5: + No instance for (Int -> Int) {x :: Bool} + arising from a use of the record selector ‘x’ + The type ‘(->)’ does not have a field ‘x’ + In the expression: x + In the expression: x ((\ x -> x) :: Int -> Int) :: Bool + In an equation for ‘d’: d = x ((\ x -> x) :: Int -> Int) :: Bool + +overloadedrecfldsfail02.hs:17:5: + Could not deduce (T a0) {x :: t} + arising from a use of the record selector ‘x’ + from the context ((T Int) {foo :: t}) + bound by the type signature for e :: (T Int) {foo :: t} => t + at overloadedrecfldsfail02.hs:16:6-30 + The field ‘x’ of ‘T’ cannot be overloaded, + as its type is existentially quantified + The type variable ‘a0’ is ambiguous + Relevant bindings include + e :: t (bound at overloadedrecfldsfail02.hs:17:1) + In the expression: x + In the expression: x (MkT True) + In an equation for ‘e’: e = x (MkT True) diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail03.hs b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail03.hs new file mode 100644 index 0000000000..2f460229a9 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail03.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE OverloadedRecordFields #-} + +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..e3fb895c90 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail03.stderr @@ -0,0 +1,5 @@ + +overloadedrecfldsfail03.hs:5:16: + Multiple declarations of ‘foo’ + Declared at: overloadedrecfldsfail03.hs:3:1 + overloadedrecfldsfail03.hs:5: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..24e57d4508 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail04.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE OverloadedRecordFields #-} + +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 } \ No newline at end of file diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail04.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail04.stderr new file mode 100644 index 0000000000..2f3c9121ae --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail04.stderr @@ -0,0 +1,5 @@ +[1 of 2] Compiling OverloadedRecFldsFail04_A ( OverloadedRecFldsFail04_A.hs, OverloadedRecFldsFail04_A.o ) +[2 of 2] Compiling Main ( overloadedrecfldsfail04.hs, overloadedrecfldsfail04.o ) + +overloadedrecfldsfail04.hs:6:6: + Overloaded record field should not be qualified: ‘I.x’ diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail05.hs b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail05.hs new file mode 100644 index 0000000000..7ce06dc49e --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail05.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE OverloadedRecordFields, TypeFamilies, FlexibleInstances, + DataKinds, MultiParamTypeClasses #-} + +import GHC.Records + +data Person = MkPerson { firstName :: String, lastName :: String } + +type instance FldTy Person "fullName" = String +instance Has Person "fullName" String where + getField _ p = firstName p ++ " " ++ lastName p diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail05.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail05.stderr new file mode 100644 index 0000000000..75ad89a3f9 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail05.stderr @@ -0,0 +1,10 @@ + +overloadedrecfldsfail05.hs:8:15: + Illegal type instance declaration for ‘FldTy’ + (Use -XOverloadedRecordFields instead.) + In the type instance declaration for ‘FldTy’ + +overloadedrecfldsfail05.hs:9:10: + Illegal instance declaration for ‘Has Person "fullName" String’ + The class is abstract, manual instances are not permitted. + In the instance declaration for ‘Has Person "fullName" String’ diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.hs b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.hs new file mode 100644 index 0000000000..067b3d6aaf --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE OverloadedRecordFields #-} +{-# OPTIONS_GHC -Werror -fwarn-unused-imports #-} + +import OverloadedRecFldsFail06_A (U(x, y), V(MkV, MkV2, x, y), Unused(unused), u, getX, getY) + +foo r = getY r + +-- Check that this counts a use of U(x) and V(y) but not U(y) or V(x) +main = do print (getX u) + print (y (MkV2 True)) diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.stderr new file mode 100644 index 0000000000..9141a3f224 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail06.stderr @@ -0,0 +1,15 @@ +[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’ +[2 of 2] Compiling Main ( overloadedrecfldsfail06.hs, overloadedrecfldsfail06.o ) + +overloadedrecfldsfail06.hs:4:1: Warning: + The import of ‘Unused(unused), V(x), U(y), MkV, Unused’ + from module ‘OverloadedRecFldsFail06_A’ is redundant + +: +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..1448db6c53 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail07.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE OverloadedRecordFields #-} +{-# 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), but the DefUse +-- machinery is not currently accurate enough to spot this +main = print (foo (MkS 3)) diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail07.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail07.stderr new file mode 100644 index 0000000000..cb0d37a20e --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail07.stderr @@ -0,0 +1,6 @@ + +overloadedrecfldsfail07.hs:7:16: Warning: + Defined but not used: ‘foo’ + +: +Failing due to -Werror. diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail08.hs b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail08.hs new file mode 100644 index 0000000000..64859661d7 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail08.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE OverloadedRecordFields #-} + +import OverloadedRecFldsFail08_A + +-- Testing bogus instances (for universally or existentially +-- quantified field types) imported from another module +a = x (MkT True) :: Bool +b = y (MkU id) +c = z (MkU2 (\ _ -> ())) +d = foo (MkFInt 42) +e = foo (MkFBool id) + +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..31b7ad87e0 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail08.stderr @@ -0,0 +1,47 @@ +[1 of 2] Compiling OverloadedRecFldsFail08_A ( OverloadedRecFldsFail08_A.hs, OverloadedRecFldsFail08_A.o ) +[2 of 2] Compiling Main ( overloadedrecfldsfail08.hs, overloadedrecfldsfail08.o ) + +overloadedrecfldsfail08.hs:7:5: + No instance for T {x :: Bool} + arising from a use of the record selector ‘x’ + The field ‘x’ of ‘T’ cannot be overloaded, + as its type is existentially quantified + In the expression: x + In the expression: x (MkT True) :: Bool + In an equation for ‘a’: a = x (MkT True) :: Bool + +overloadedrecfldsfail08.hs:8:5: + No instance for U {y :: ...} + arising from a use of the record selector ‘y’ + The field ‘y’ of ‘U’ cannot be overloaded, + as its type is universally quantified + In the expression: y + In the expression: y (MkU id) + In an equation for ‘b’: b = y (MkU id) + +overloadedrecfldsfail08.hs:9:5: + No instance for U {z :: ...} + arising from a use of the record selector ‘z’ + The field ‘z’ of ‘U’ cannot be overloaded, + as its type is universally quantified + In the expression: z + In the expression: z (MkU2 (\ _ -> ())) + In an equation for ‘c’: c = z (MkU2 (\ _ -> ())) + +overloadedrecfldsfail08.hs:10:5: + No instance for (F Int) {foo :: ...} + arising from a use of the record selector ‘foo’ + The field ‘foo’ of ‘F Int’ cannot be overloaded, + as its type is existentially quantified + In the expression: foo + In the expression: foo (MkFInt 42) + In an equation for ‘d’: d = foo (MkFInt 42) + +overloadedrecfldsfail08.hs:11:5: + No instance for (F Bool) {foo :: ...} + arising from a use of the record selector ‘foo’ + The field ‘foo’ of ‘F Bool’ cannot be overloaded, + as its type is universally quantified + In the expression: foo + In the expression: foo (MkFBool id) + In an equation for ‘e’: e = foo (MkFBool id) diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail09.hs b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail09.hs new file mode 100644 index 0000000000..65af8b1cc0 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail09.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE DataKinds, TypeFamilies, FlexibleInstances, MultiParamTypeClasses #-} + +import GHC.Records + +-- These instances are all illegal +type instance FldTy Int "foo" = Int +type instance UpdTy Int "foo" Int = Int +instance Has Int "foo" Int +instance Upd Int "foo" Int diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail09.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail09.stderr new file mode 100644 index 0000000000..51b83134ed --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail09.stderr @@ -0,0 +1,20 @@ + +overloadedrecfldsfail09.hs:6:15: + Illegal type instance declaration for ‘FldTy’ + (Use -XOverloadedRecordFields instead.) + In the type instance declaration for ‘FldTy’ + +overloadedrecfldsfail09.hs:7:15: + Illegal type instance declaration for ‘UpdTy’ + (Use -XOverloadedRecordFields instead.) + In the type instance declaration for ‘UpdTy’ + +overloadedrecfldsfail09.hs:8:10: + Illegal instance declaration for ‘Has Int "foo" Int’ + The class is abstract, manual instances are not permitted. + In the instance declaration for ‘Has Int "foo" Int’ + +overloadedrecfldsfail09.hs:9:10: + Illegal instance declaration for ‘Upd Int "foo" Int’ + The class is abstract, manual instances are not permitted. + In the instance declaration for ‘Upd Int "foo" Int’ diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail10.hs b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail10.hs new file mode 100644 index 0000000000..e818e4447d --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail10.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE OverloadedRecordFields, NoMonomorphismRestriction, ExistentialQuantification #-} + +data T = forall e . MkT { x :: e -> e } + +-- Without the monomorphism restriction, this could be given type +-- v :: T { x :: t } => t +-- but it is inferred as T { x :: GetResult T "x" }, which doesn't get +-- quantified over because it has no free variables. +v = x (MkT id) + +main = print () diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail10.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail10.stderr new file mode 100644 index 0000000000..0c268a47f5 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedrecfldsfail10.stderr @@ -0,0 +1,9 @@ + +overloadedrecfldsfail10.hs:9:5: + No instance for T {x :: ...} + arising from a use of the record selector ‘x’ + The field ‘x’ of ‘T’ cannot be overloaded, + as its type is existentially quantified + In the expression: x + In the expression: x (MkT id) + In an equation for ‘v’: v = x (MkT id) 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/OverloadedRecFldsRun01_A.hs b/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun01_A.hs new file mode 100644 index 0000000000..474b3acf6b --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun01_A.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE OverloadedRecordFields #-} + +module OverloadedRecFldsRun01_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/OverloadedRecFldsRun02_A.hs b/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun02_A.hs new file mode 100644 index 0000000000..799ac9a998 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun02_A.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE OverloadedRecordFields #-} + +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/OverloadedRecFldsRun07_A.hs b/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun07_A.hs new file mode 100644 index 0000000000..24f52bb5c0 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun07_A.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE OverloadedRecordFields, TypeFamilies #-} + +module OverloadedRecFldsRun07_A where + +data family F a + +data instance F Bool = MkFBool { foo :: Bool } + deriving Show + +data instance F Char = MkFChar { bar :: Char } + deriving Show diff --git a/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun07_B.hs b/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun07_B.hs new file mode 100644 index 0000000000..6f0d5aee90 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun07_B.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE OverloadedRecordFields, TypeFamilies #-} + +module OverloadedRecFldsRun07_B ( F(..) ) where + +import OverloadedRecFldsRun07_A ( F(..) ) + +data instance F Int = MkFInt { foo :: Int } diff --git a/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun08_A.hs b/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun08_A.hs new file mode 100644 index 0000000000..02e507f2f7 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun08_A.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE OverloadedRecordFields, TypeFamilies #-} + +module OverloadedRecFldsRun08_A where + +data family F a + +data instance F Bool = MkFBool { foo :: Bool } + deriving Show + +data instance F Char = MkFChar { bar :: Char } + deriving Show diff --git a/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun08_B.hs b/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun08_B.hs new file mode 100644 index 0000000000..b9fae4d9b2 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun08_B.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE OverloadedRecordFields, TypeFamilies #-} + +module OverloadedRecFldsRun08_B ( F(..) ) where + +import OverloadedRecFldsRun08_A ( F(..) ) + +data instance F Int = MkFInt { foo :: Int } diff --git a/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun08_C.hs b/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun08_C.hs new file mode 100644 index 0000000000..d2bb964c3e --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun08_C.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE OverloadedRecordFields, TypeFamilies #-} + +module OverloadedRecFldsRun08_C ( F(..) ) where + +import OverloadedRecFldsRun08_A ( F(..) ) + +data instance F () = MkFUnit { foo :: () } diff --git a/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun11_A.hs b/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun11_A.hs new file mode 100644 index 0000000000..f4f9ea937f --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun11_A.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE OverloadedRecordFields #-} + +module OverloadedRecFldsRun11_A where + +import OverloadedRecFldsRun11_B + +data T = MkT { foo :: Int } + +baz r = bar r diff --git a/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun11_A.hs-boot b/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun11_A.hs-boot new file mode 100644 index 0000000000..148baca3b1 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun11_A.hs-boot @@ -0,0 +1,5 @@ +{-# LANGUAGE OverloadedRecordFields #-} + +module OverloadedRecFldsRun11_A where + +data T = MkT { foo :: Int } diff --git a/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun11_B.hs b/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun11_B.hs new file mode 100644 index 0000000000..346590e241 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun11_B.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE OverloadedRecordFields #-} + +module OverloadedRecFldsRun11_B where + +import {-# SOURCE #-} OverloadedRecFldsRun11_A + +bar r = foo r diff --git a/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun12_A.hs b/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun12_A.hs new file mode 100644 index 0000000000..c479625bd5 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun12_A.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE OverloadedRecordFields, TypeFamilies #-} + +module OverloadedRecFldsRun12_A where + +data family F a + +data instance F Bool = MkFBool { foo :: Bool } + deriving Show + +data instance F Char = MkFChar { bar :: Char } + deriving Show diff --git a/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun12_B.hs b/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun12_B.hs new file mode 100644 index 0000000000..3bf598bc23 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/OverloadedRecFldsRun12_B.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TypeFamilies #-} + +module OverloadedRecFldsRun12_B ( F(foo, MkFInt, MkFBool) ) where + +import OverloadedRecFldsRun12_A ( F(..) ) + +data instance F Int = MkFInt { foo :: Int } diff --git a/testsuite/tests/overloadedrecflds/should_run/all.T b/testsuite/tests/overloadedrecflds/should_run/all.T new file mode 100644 index 0000000000..4098a5a302 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/all.T @@ -0,0 +1,26 @@ +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, ['']) +test('overloadedrecfldsrun06', normal, compile_and_run, ['']) +test('overloadedrecfldsrun07', + extra_clean(['OverloadedRecFldsRun07_A.hi', 'OverloadedRecFldsRun07_A.o', + 'OverloadedRecFldsRun07_B.hi', 'OverloadedRecFldsRun07_B.o']), + multimod_compile_and_run, ['overloadedrecfldsrun07', '']) +test('overloadedrecfldsrun08', + extra_clean(['OverloadedRecFldsRun08_A.hi', 'OverloadedRecFldsRun08_A.o', + 'OverloadedRecFldsRun08_B.hi', 'OverloadedRecFldsRun08_B.o', + 'OverloadedRecFldsRun08_C.hi', 'OverloadedRecFldsRun08_C.o']), + multimod_compile_and_run, ['overloadedrecfldsrun08', '']) +test('overloadedrecfldsrun10', exit_code(1), compile_and_run, ['']) +test('overloadedrecfldsrun11', normal, compile_and_run, ['']) +test('overloadedrecfldsrun12', + extra_clean(['OverloadedRecFldsRun12_A.hi', 'OverloadedRecFldsRun12_A.o', + 'OverloadedRecFldsRun12_B.hi', 'OverloadedRecFldsRun12_B.o']), + multimod_compile_and_run, ['overloadedrecfldsrun12', '']) +test('overloadedrecfldsrun13', 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..214be1ea4f --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun01.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE OverloadedRecordFields, DataKinds, KindSignatures, + ExistentialQuantification, RankNTypes, TypeFamilies, + MagicHash #-} +{-# OPTIONS_GHC -fwarn-unused-imports -fwarn-unused-binds #-} + +import GHC.Prim (proxy#, Proxy#) +import GHC.Records +import OverloadedRecFldsRun01_A as I (U(MkU, x), V(..), Unused(unused)) + +data S = MkS { x :: Int } + deriving Show + +data T = MkT { x :: Bool, y :: Bool -> Bool, tField :: Bool } + +-- Updates to `x` may change only the type of `c` +data W a b c d = MkW { x :: (a, b, c), y :: a, z :: d } + | MkW2 { x :: (a, b, c), foo :: b } + deriving Show + +-- Only the `okay` field generates Has/Upd instances +data X a = forall e . MkX { existential :: (Int, e) + , universal :: (forall b . b) -> () + , x :: a } + +-- We can have data families too, provided a single data family +-- doesn't overload the same field name +data family F (a :: *) (b :: *) :: * -> * +data instance F Int b Int = MkF { foo :: Int } | MkF' { foo :: Int } +data instance F Int b Bool = MkF2 { bar :: Bool } + + +s = MkS 42 +t = MkT True id False +w = MkW { x = (True, True, True), y = True, z = True } + +-- 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 + +-- Specialised getter and setter +get_x :: r { x :: a } => r -> a +get_x r = x r + +set_x :: Upd r "x" a => r -> a -> UpdTy r "x" a +set_x = setField (proxy# :: Proxy# "x") + +-- Type-changing update is possible in places +d = set_x w (False, False, 'x') +e = setField (proxy# :: Proxy# "z") d 42 + +f :: Int +f = x (set_x (MkX {x = True}) 42) + +g = foo (MkF 3) +h = bar (MkF2 True) + +main = do print (x s) + print (x (MkT False id True)) + print (y t (x t)) + print (x (MkU True False)) + print (x (MkV 3)) + print (get_x a) + print b + print (get_x c) + print d + print e + print f + print g + print h diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun01.stdout b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun01.stdout new file mode 100644 index 0000000000..6b73c2de99 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun01.stdout @@ -0,0 +1,13 @@ +42 +False +True +True +3 +False +MkS {x = 3} +False +MkW {x = (False,False,'x'), y = True, z = True} +MkW {x = (False,False,'x'), y = True, z = 42} +42 +3 +True diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun02.hs b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun02.hs new file mode 100644 index 0000000000..9b97f8ed75 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun02.hs @@ -0,0 +1,6 @@ +-- This module does not enable -XOverloadedRecordFields, 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..bfe6d16bdc --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun03.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE OverloadedRecordFields, TypeFamilies #-} + +data family F a + +data instance F Int = MkFInt { foo :: Int } +data instance F Bool = MkFBool { bar :: Bool } + + +data family G a + +data instance G Int = MkGInt { foo :: Int } +data instance G Bool = MkGBool { bar :: Bool } + + +main = do print (foo (MkFInt 42)) + print (foo (MkGInt 42)) + print (bar (MkFBool True)) + print (bar (MkGBool True)) diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun03.stdout b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun03.stdout new file mode 100644 index 0000000000..4a87c5d146 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun03.stdout @@ -0,0 +1,4 @@ +42 +42 +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..d49a56c94a --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun04.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE OverloadedRecordFields, TemplateHaskell #-} + +import GHC.Records +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) }) + putStrLn $(do { insts <- reifyInstances ''Has [ConT ''R, LitT (StrTyLit "foo"), ConT ''Int] + ; lift (pprint insts) }) + 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..b24c664de6 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun04.stdout @@ -0,0 +1,3 @@ +data Main.R = Main.MkR {Main.$sel:foo:R :: 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..41f8ae1888 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun05.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE OverloadedRecordFields, DataKinds, PolyKinds, GADTs, + StandaloneDeriving, TypeFamilies, UndecidableInstances, + MagicHash #-} + +import GHC.Prim (Proxy#, proxy#) +import GHC.Records + +data T (a :: x -> *)(b :: x) :: * where + MkT :: a b -> T a b + +deriving instance Show (a b) => Show (T a b) + +data U (a :: x -> *)(b :: x)(c :: y -> *)(d :: y) + = MkU { bar :: T a b, baz :: T c d } + deriving Show + +data V (a :: x -> *)(b :: x)(c :: x -> *)(d :: x) + = MkV { bar :: T a b, baz :: T c d } + deriving Show + +data F (f :: * -> *) = MkF + deriving Show + +-- Updates to fields of U may change kinds: +-- x :: U F f [] Bool +x = setField (proxy# :: Proxy# "bar") (MkU (MkT [3]) (MkT [False])) (MkT MkF) + +-- Updates to fields of V may not, but may change types: +-- y :: V Maybe Int [] Bool +y = setField (proxy# :: Proxy# "bar") (MkV (MkT [3]) (MkT [False])) (MkT (Just 6)) + + +main = do print x + print y diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun05.stdout b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun05.stdout new file mode 100644 index 0000000000..39d20c6a15 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun05.stdout @@ -0,0 +1,2 @@ +MkU {bar = MkT MkF, baz = MkT [False]} +MkV {bar = MkT (Just 6), baz = MkT [False]} diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun06.hs b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun06.hs new file mode 100644 index 0000000000..90e1a18310 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun06.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE OverloadedRecordFields, DataKinds, PolyKinds, GADTs, + StandaloneDeriving, TypeFamilies, UndecidableInstances, + MagicHash #-} + +import GHC.Prim (Proxy#, proxy#) +import GHC.Records + +type family Foo b +type instance Foo Int = Bool +type instance Foo Bool = Int + +data W a = MkW { foo :: Foo a } + +deriving instance Show (Foo a) => Show (W a) + +data X b = MkX { bar :: W (Foo b) } + +deriving instance Show (Foo (Foo a)) => Show (X a) + +r :: W Int +r = MkW { foo = True } + +-- Updates cannot change types, since the variables are not rigid +z :: X Bool +z = setField (proxy# :: Proxy# "bar") (MkX r) $ + setField (proxy# :: Proxy# "foo") r False + +main = print z diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun06.stdout b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun06.stdout new file mode 100644 index 0000000000..1d2a94d64e --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun06.stdout @@ -0,0 +1 @@ +MkX {bar = MkW {foo = False}} diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun07.hs b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun07.hs new file mode 100644 index 0000000000..56841a77a3 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun07.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE OverloadedRecordFields #-} + +import OverloadedRecFldsRun07_B + +main = do print (foo (MkFBool True)) + print (foo (MkFInt 3)) + print (bar (MkFChar 'a')) diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun07.stdout b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun07.stdout new file mode 100644 index 0000000000..d9e44a413e --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun07.stdout @@ -0,0 +1,3 @@ +True +3 +'a' diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun08.hs b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun08.hs new file mode 100644 index 0000000000..c68163dde9 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun08.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE OverloadedRecordFields #-} + +import OverloadedRecFldsRun08_B +import OverloadedRecFldsRun08_C + +main = do print (foo (MkFInt 3)) + print (foo (MkFUnit ())) diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun08.stdout b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun08.stdout new file mode 100644 index 0000000000..d916638919 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun08.stdout @@ -0,0 +1,2 @@ +3 +() diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun09.hs b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun09.hs new file mode 100644 index 0000000000..c15292faf0 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun09.hs @@ -0,0 +1,8 @@ +-{-# LANGUAGE OverloadedRecordFields, TypeFamilies #-} + +data family F a +data instance F Int = MkFInt { foo :: Int } +data instance F Bool = MkFBool { foo :: Bool } + +main = do print (MkFInt 42) + print (MkFBool True) diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun09.stdout b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun09.stdout new file mode 100644 index 0000000000..abc4e3b957 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun09.stdout @@ -0,0 +1,2 @@ +42 +True diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun10.hs b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun10.hs new file mode 100644 index 0000000000..defffc1d6d --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun10.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE OverloadedRecordFields, DataKinds, MagicHash #-} + +import GHC.Prim (Proxy#, proxy#) +import GHC.Records + +data T = MkT { foo :: Int } | MkT2 { bar :: Bool } + deriving Show + +x = MkT 42 + +-- This should generate a suitable runtime error +main = print (setField (proxy# :: Proxy# "bar") x True) diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun10.stderr b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun10.stderr new file mode 100644 index 0000000000..2242bd5ea6 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun10.stderr @@ -0,0 +1,2 @@ +overloadedrecfldsrun10: setField: Non-exhaustive patterns in overloaded record update: bar + diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun11.hs b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun11.hs new file mode 100644 index 0000000000..3b80f745aa --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun11.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE OverloadedRecordFields #-} + +import OverloadedRecFldsRun11_A + +main = print (baz (MkT 42)) diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun11.stdout b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun11.stdout new file mode 100644 index 0000000000..d81cc0710e --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun11.stdout @@ -0,0 +1 @@ +42 diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun12.hs b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun12.hs new file mode 100644 index 0000000000..33f412d77d --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun12.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE OverloadedRecordFields #-} + +import OverloadedRecFldsRun12_B (F(MkFInt, MkFBool, foo)) + +main = do print (foo (MkFInt 42)) + print (foo (MkFBool True)) diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun12.stdout b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun12.stdout new file mode 100644 index 0000000000..abc4e3b957 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun12.stdout @@ -0,0 +1,2 @@ +42 +True diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun13.hs b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun13.hs new file mode 100644 index 0000000000..90b90ae04e --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun13.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE OverloadedRecordFields #-} + +data T = MkT { foo :: Int, bar :: Int } + +-- Test multiple fields +f :: (r { foo :: a, bar :: a }, Num a) => r -> a +f x = foo x + bar x + +main = print $ f MkT { foo = 2, bar = 3 } diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun13.stdout b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun13.stdout new file mode 100644 index 0000000000..7ed6ff82de --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun13.stdout @@ -0,0 +1 @@ +5 diff --git a/testsuite/tests/rename/should_fail/T5892a.stderr b/testsuite/tests/rename/should_fail/T5892a.stderr index 1600d8fa39..6cea309fc5 100644 --- a/testsuite/tests/rename/should_fail/T5892a.stderr +++ b/testsuite/tests/rename/should_fail/T5892a.stderr @@ -1,6 +1,6 @@ T5892a.hs:12:8: Warning: - Fields of ‘Version’ not initialised: Data.Version.versionTags + Fields of ‘Version’ not initialised: versionTags In the expression: Version {..} In the expression: let versionBranch = [] in Version {..} In an equation for ‘foo’: diff --git a/testsuite/tests/typecheck/should_fail/tcfail102.stderr b/testsuite/tests/typecheck/should_fail/tcfail102.stderr index 01a8bba99a..1426d9c4ec 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail102.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail102.stderr @@ -3,7 +3,8 @@ tcfail102.hs:1:14: Warning: -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language. tcfail102.hs:9:15: - Could not deduce (Integral (Ratio a)) arising from a use of ‘p’ + Could not deduce (Integral (Ratio a)) + arising from a use of the record selector ‘p’ from the context (Integral a) bound by the type signature for f :: Integral a => P (Ratio a) -> P (Ratio a) -- cgit v1.2.1