diff options
Diffstat (limited to 'testsuite/tests')
54 files changed, 520 insertions, 3 deletions
diff --git a/testsuite/tests/driver/T4437.hs b/testsuite/tests/driver/T4437.hs index c197cbd5dc..48ad93cbc9 100644 --- a/testsuite/tests/driver/T4437.hs +++ b/testsuite/tests/driver/T4437.hs @@ -33,6 +33,7 @@ expectedGhcOnlyExtensions :: [String] expectedGhcOnlyExtensions = ["RelaxedLayout", "AlternativeLayoutRule", "AlternativeLayoutRuleTransitional", + "DuplicateRecordFields", "StaticPointers", "StrictData", "ApplicativeDo"] -- TODO add this to Cabal 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..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} diff --git a/testsuite/tests/rename/should_compile/T7145b.stderr b/testsuite/tests/rename/should_compile/T7145b.stderr index d5f7c08558..ed2333e8c4 100644 --- a/testsuite/tests/rename/should_compile/T7145b.stderr +++ b/testsuite/tests/rename/should_compile/T7145b.stderr @@ -1,2 +1,2 @@ -T7145b.hs:7:1: Warning: Defined but not used: ‘T7145b.pure’ +T7145b.hs:7:1: Warning: Defined but not used: ‘pure’ diff --git a/testsuite/tests/rename/should_fail/T5892a.stderr b/testsuite/tests/rename/should_fail/T5892a.stderr index 5e9e4d305f..f382cd3811 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 ‘Node’ not initialised: Data.Tree.subForest + Fields of ‘Node’ not initialised: subForest In the expression: Node {..} In the expression: let rootLabel = [] in Node {..} In an equation for ‘foo’: |