diff options
Diffstat (limited to 'testsuite/tests/overloadedrecflds/should_run')
40 files changed, 394 insertions, 0 deletions
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 |