diff options
Diffstat (limited to 'testsuite')
21 files changed, 212 insertions, 118 deletions
diff --git a/testsuite/tests/linear/should_compile/LinearDataConSections.hs b/testsuite/tests/linear/should_compile/LinearDataConSections.hs index 8a71a494c8..b00fabced5 100644 --- a/testsuite/tests/linear/should_compile/LinearDataConSections.hs +++ b/testsuite/tests/linear/should_compile/LinearDataConSections.hs @@ -14,4 +14,4 @@ foo :: Char %Many -> D foo = (True `MkD`) bar :: Bool %Many -> D -bar = (`MkD` 'y')
\ No newline at end of file +bar = (`MkD` 'y') diff --git a/testsuite/tests/rename/should_fail/rnfail055.stderr b/testsuite/tests/rename/should_fail/rnfail055.stderr index 5034a85ec2..787009a4c6 100644 --- a/testsuite/tests/rename/should_fail/rnfail055.stderr +++ b/testsuite/tests/rename/should_fail/rnfail055.stderr @@ -52,6 +52,7 @@ RnFail055.hs-boot:15:1: error: The roles do not match. Roles on abstract types default to ‘representational’ in boot files. The datatype contexts do not match + The constructors do not match: The types for ‘T2’ differ RnFail055.hs-boot:17:11: error: ‘T3’ is exported by the hs-boot file, but not exported by the module diff --git a/testsuite/tests/rep-poly/EtaExpandDataCon.hs b/testsuite/tests/rep-poly/EtaExpandDataCon.hs index fb4618578a..9f31b7f452 100644 --- a/testsuite/tests/rep-poly/EtaExpandDataCon.hs +++ b/testsuite/tests/rep-poly/EtaExpandDataCon.hs @@ -39,7 +39,6 @@ newtype N3 a where foo3 :: (a %1 -> N3 a) -> N3 a foo3 = MkN3 - type D4 :: TYPE FloatRep -> Type -> Type data D4 a b = MkD4 a b b diff --git a/testsuite/tests/rep-poly/EtaExpandDataFamily.hs b/testsuite/tests/rep-poly/EtaExpandDataFamily.hs deleted file mode 100644 index 02475f6cb1..0000000000 --- a/testsuite/tests/rep-poly/EtaExpandDataFamily.hs +++ /dev/null @@ -1,29 +0,0 @@ - -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DatatypeContexts #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE StandaloneKindSignatures #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UnliftedNewtypes #-} - -module EtaExpandDataFamily where - -import Data.Kind -import GHC.Exts - - -type N :: forall (r :: RuntimeRep) -> TYPE r -> TYPE r -data family N r a -newtype instance N r a = MkN a - -foo :: Int# -> N IntRep Int# -foo = MkN - - -type N :: forall (r :: RuntimeRep) -> TYPE r -> Type -> Type -> Type -> TYPE r -data family N r a i -newtype instance Ord b => N r a Int b c = MkN a - -foo :: Ord b => Int# -> N IntRep Int# Int b c -foo = MkN diff --git a/testsuite/tests/rep-poly/RepPolyMagic.stderr b/testsuite/tests/rep-poly/RepPolyMagic.stderr index f99d0c740a..47e7ba81d3 100644 --- a/testsuite/tests/rep-poly/RepPolyMagic.stderr +++ b/testsuite/tests/rep-poly/RepPolyMagic.stderr @@ -4,23 +4,15 @@ RepPolyMagic.hs:12:7: error: The second argument of ‘seq’ does not have a fixed runtime representation. Its type is: - b0 :: TYPE c1 - Cannot unify ‘r’ with the type variable ‘c1’ - because it is not a concrete ‘RuntimeRep’. + b :: TYPE r • In the expression: seq In an equation for ‘foo’: foo = seq - • Relevant bindings include - foo :: a -> b -> b (bound at RepPolyMagic.hs:12:1) RepPolyMagic.hs:15:7: error: • Unsaturated use of a representation-polymorphic primitive function. The second argument of ‘oneShot’ does not have a fixed runtime representation. Its type is: - a0 :: TYPE c0 - Cannot unify ‘r’ with the type variable ‘c0’ - because it is not a concrete ‘RuntimeRep’. + a :: TYPE r • In the expression: oneShot In an equation for ‘bar’: bar = oneShot - • Relevant bindings include - bar :: (a -> a) -> a -> a (bound at RepPolyMagic.hs:15:1) diff --git a/testsuite/tests/rep-poly/RepPolyRightSection.stderr b/testsuite/tests/rep-poly/RepPolyRightSection.stderr index fdc7a399fa..62c0bdcd8d 100644 --- a/testsuite/tests/rep-poly/RepPolyRightSection.stderr +++ b/testsuite/tests/rep-poly/RepPolyRightSection.stderr @@ -4,10 +4,6 @@ RepPolyRightSection.hs:14:11: error: The third argument of ‘rightSection’ does not have a fixed runtime representation. Its type is: - a :: TYPE c0 - Cannot unify ‘r’ with the type variable ‘c0’ - because it is not a concrete ‘RuntimeRep’. + a :: TYPE r • In the expression: `g` undefined In an equation for ‘test2’: test2 = (`g` undefined) - • Relevant bindings include - test2 :: a -> a (bound at RepPolyRightSection.hs:14:1) diff --git a/testsuite/tests/rep-poly/RepPolyTuple2.hs b/testsuite/tests/rep-poly/RepPolyTuple2.hs new file mode 100644 index 0000000000..43e590587b --- /dev/null +++ b/testsuite/tests/rep-poly/RepPolyTuple2.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UnboxedTuples #-} + +module RepPolyTuple2 where + +import GHC.Exts + +type RR :: RuntimeRep +type family RR where { RR = FloatRep } +type F :: TYPE RR +type family F where { F = Float# } + +{-# NOINLINE expensive #-} +expensive :: Float -> Float +expensive x = cos x ** 123.45 + +tup x = (# , #) @LiftedRep @RR (expensive x) diff --git a/testsuite/tests/rep-poly/RepPolyTuple2.stderr b/testsuite/tests/rep-poly/RepPolyTuple2.stderr new file mode 100644 index 0000000000..558e1bf1bb --- /dev/null +++ b/testsuite/tests/rep-poly/RepPolyTuple2.stderr @@ -0,0 +1,10 @@ + +RepPolyTuple2.hs:21:9: error: + • Unsaturated use of a representation-polymorphic data constructor. + The second argument of ‘(#,#)’ + does not have a fixed runtime representation. + Its type is: + b :: TYPE RR + • In the expression: (#,#) @LiftedRep @RR (expensive x) + In an equation for ‘tup’: + tup x = (#,#) @LiftedRep @RR (expensive x) diff --git a/testsuite/tests/rep-poly/RepPolyUnliftedNewtype.hs b/testsuite/tests/rep-poly/RepPolyUnliftedNewtype.hs new file mode 100644 index 0000000000..65a1fea656 --- /dev/null +++ b/testsuite/tests/rep-poly/RepPolyUnliftedNewtype.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DatatypeContexts #-} +{-# LANGUAGE LinearTypes #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE UnliftedNewtypes #-} + +module RepPolyUnliftedNewtype where + +import GHC.Exts +import GHC.Types (Multiplicity(..)) + +type C :: forall (r :: RuntimeRep). TYPE r -> Constraint +class C a +instance C Int# + +type N :: forall (r :: RuntimeRep). TYPE r -> TYPE r +newtype C a => N a = MkN a + +f1, f2, f3, f4, f5, f6, f7 :: Int# %Many -> N Int# +f1 = MkN +f2 = MkN @_ +f3 = MkN @IntRep +f4 = MkN @_ @_ +f5 = MkN @_ @Int# +f6 = MkN @IntRep @_ +f7 = MkN @IntRep @Int# + +g1, g2, g3, g4, g5, g6, g7 :: Int# %Many -> N Int# +g1 x = MkN x +g2 x = MkN @_ x +g3 x = MkN @IntRep x +g4 x = MkN @_ @_ x +g5 x = MkN @_ @Int# x +g6 x = MkN @IntRep @_ x +g7 x = MkN @IntRep @Int# x + +h3, h5, h6, h7 :: _ => _ %Many -> N _ +h3 = MkN @IntRep +h5 = MkN @_ @Int# +h6 = MkN @IntRep @_ +h7 = MkN @IntRep @Int# + +k1 (x :: Int#) = MkN x +k2 (x :: Int#) = MkN @_ x +k3 x = MkN @IntRep x +k4 (x :: Int#) = MkN @_ @_ x +k5 x = MkN @_ @Int# x +k6 x = MkN @IntRep @_ x +k7 x = MkN @IntRep @Int# x + +l1 = (MkN :: Int# %Many -> N Int#) diff --git a/testsuite/tests/rep-poly/T13233.stderr b/testsuite/tests/rep-poly/T13233.stderr index 5b083ea6c7..c7e6be02fc 100644 --- a/testsuite/tests/rep-poly/T13233.stderr +++ b/testsuite/tests/rep-poly/T13233.stderr @@ -1,24 +1,30 @@ T13233.hs:14:11: error: - • The data constructor argument in second position - does not have a fixed runtime representation. - Its type is: - b1 :: TYPE c3 - Cannot unify ‘rep’ with the type variable ‘c3’ - because it is not a concrete ‘RuntimeRep’. + • • Unsaturated use of a representation-polymorphic data constructor. + The second argument of ‘(#,#)’ + does not have a fixed runtime representation. + Its type is: + a :: TYPE rep + • Unsaturated use of a representation-polymorphic data constructor. + The first argument of ‘(#,#)’ + does not have a fixed runtime representation. + Its type is: + a :: TYPE rep • In the first argument of ‘bar’, namely ‘(#,#)’ In the expression: bar (#,#) In an equation for ‘baz’: baz = bar (#,#) - • Relevant bindings include - baz :: a -> a -> (# a, a #) (bound at T13233.hs:14:1) T13233.hs:22:16: error: - • The data constructor argument in second position - does not have a fixed runtime representation. - Its type is: - b0 :: TYPE c1 - Cannot unify ‘rep2’ with the type variable ‘c1’ - because it is not a concrete ‘RuntimeRep’. + • • Unsaturated use of a representation-polymorphic data constructor. + The second argument of ‘(#,#)’ + does not have a fixed runtime representation. + Its type is: + b :: TYPE rep2 + • Unsaturated use of a representation-polymorphic data constructor. + The first argument of ‘(#,#)’ + does not have a fixed runtime representation. + Its type is: + a :: TYPE rep1 • In the first argument of ‘obscure’, namely ‘(#,#)’ In the expression: obscure (#,#) In an equation for ‘quux’: quux = obscure (#,#) diff --git a/testsuite/tests/rep-poly/T14561.stderr b/testsuite/tests/rep-poly/T14561.stderr index 8f102143eb..3c372e689c 100644 --- a/testsuite/tests/rep-poly/T14561.stderr +++ b/testsuite/tests/rep-poly/T14561.stderr @@ -4,10 +4,6 @@ T14561.hs:12:9: error: The first argument of ‘unsafeCoerce#’ does not have a fixed runtime representation. Its type is: - a0 :: TYPE c0 - Cannot unify ‘r’ with the type variable ‘c0’ - because it is not a concrete ‘RuntimeRep’. + a :: TYPE r • In the expression: unsafeCoerce# In an equation for ‘badId’: badId = unsafeCoerce# - • Relevant bindings include - badId :: a -> a (bound at T14561.hs:12:1) diff --git a/testsuite/tests/rep-poly/T14561b.stderr b/testsuite/tests/rep-poly/T14561b.stderr index bbc72d01d8..7af3b05511 100644 --- a/testsuite/tests/rep-poly/T14561b.stderr +++ b/testsuite/tests/rep-poly/T14561b.stderr @@ -4,10 +4,6 @@ T14561b.hs:12:9: error: The first argument of ‘coerce’ does not have a fixed runtime representation. Its type is: - a0 :: TYPE c0 - Cannot unify ‘r’ with the type variable ‘c0’ - because it is not a concrete ‘RuntimeRep’. + a :: TYPE r • In the expression: coerce In an equation for ‘badId’: badId = coerce - • Relevant bindings include - badId :: a -> a (bound at T14561b.hs:12:1) diff --git a/testsuite/tests/rep-poly/T17817.stderr b/testsuite/tests/rep-poly/T17817.stderr index 4fb45622bc..7acdec120a 100644 --- a/testsuite/tests/rep-poly/T17817.stderr +++ b/testsuite/tests/rep-poly/T17817.stderr @@ -4,15 +4,6 @@ T17817.hs:16:10: error: The first argument of ‘mkWeak#’ does not have a fixed runtime representation. Its type is: - a0 :: TYPE ('BoxedRep c0) - Cannot unify ‘l’ with the type variable ‘c0’ - because it is not a concrete ‘Levity’. + a :: TYPE ('BoxedRep l) • In the expression: mkWeak# In an equation for ‘primop’: primop = mkWeak# - • Relevant bindings include - primop :: a - -> b - -> (State# RealWorld -> (# State# RealWorld, c #)) - -> State# RealWorld - -> (# State# RealWorld, Weak# b #) - (bound at T17817.hs:16:1) diff --git a/testsuite/tests/rep-poly/T21544.hs b/testsuite/tests/rep-poly/T21544.hs new file mode 100644 index 0000000000..38793c8a15 --- /dev/null +++ b/testsuite/tests/rep-poly/T21544.hs @@ -0,0 +1,29 @@ + +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DatatypeContexts #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UnliftedNewtypes #-} + +module T21544 where + +import Data.Kind +import GHC.Exts + + +type N1 :: forall (r :: RuntimeRep) -> TYPE r -> TYPE r +data family N1 r a +newtype instance N1 r a = MkN1 a + +foo1 :: Int# -> N1 IntRep Int# +foo1 = MkN1 + + +type N2 :: forall (r :: RuntimeRep) -> TYPE r -> Type -> Type -> Type -> TYPE r +data family N2 r a i +newtype instance Ord b => N2 r a Int b c = MkN2 a + +foo2 :: Ord b => Int# -> N2 IntRep Int# Int b c +foo2 = MkN2 diff --git a/testsuite/tests/rep-poly/EtaExpandNewtypeTF.hs b/testsuite/tests/rep-poly/T21650_a.hs index 9145e796b2..2c3e6aacb4 100644 --- a/testsuite/tests/rep-poly/EtaExpandNewtypeTF.hs +++ b/testsuite/tests/rep-poly/T21650_a.hs @@ -1,6 +1,6 @@ {-# LANGUAGE DataKinds, DatatypeContexts, MagicHash, UnliftedNewtypes, TypeFamilies #-} -module EtaExpandNewtypeTF where +module T21650_a where import Data.Kind import GHC.Exts diff --git a/testsuite/tests/rep-poly/T21650_a.stderr b/testsuite/tests/rep-poly/T21650_a.stderr new file mode 100644 index 0000000000..628dbced5a --- /dev/null +++ b/testsuite/tests/rep-poly/T21650_a.stderr @@ -0,0 +1,18 @@ + +T21650_a.hs:25:8: error: + • Unsaturated use of a representation-polymorphic newtype constructor. + The first argument of ‘MkN’ + does not have a fixed runtime representation. + Its type is: + F Float :: TYPE (R Float) + • In the expression: MkN + In an equation for ‘foo1’: foo1 = MkN + +T21650_a.hs:28:10: error: + • Unsaturated use of a representation-polymorphic newtype constructor. + The first argument of ‘MkN’ + does not have a fixed runtime representation. + Its type is: + F Double :: TYPE (R Double) + • In the expression: MkN + In an equation for ‘foo2’: foo2 _ = MkN diff --git a/testsuite/tests/rep-poly/EtaExpandNewtypeTF2.hs b/testsuite/tests/rep-poly/T21650_b.hs index ba973ae1f9..7274db8863 100644 --- a/testsuite/tests/rep-poly/EtaExpandNewtypeTF2.hs +++ b/testsuite/tests/rep-poly/T21650_b.hs @@ -7,7 +7,7 @@ {-# LANGUAGE UnliftedNewtypes #-} {-# LANGUAGE LinearTypes #-} -module EtaExpandNewtypeTF2 where +module T21650_b where import Data.Kind import GHC.Exts diff --git a/testsuite/tests/rep-poly/T21650_b.stderr b/testsuite/tests/rep-poly/T21650_b.stderr new file mode 100644 index 0000000000..5b2ceb0b5c --- /dev/null +++ b/testsuite/tests/rep-poly/T21650_b.stderr @@ -0,0 +1,18 @@ + +T21650_b.hs:34:7: error: + • Unsaturated use of a representation-polymorphic newtype constructor. + The first argument of ‘MkN’ + does not have a fixed runtime representation. + Its type is: + a :: TYPE (RR T1 t2) + • In the expression: MkN + In an equation for ‘foo’: foo = MkN + +T21650_b.hs:37:7: error: + • Unsaturated use of a representation-polymorphic newtype constructor. + The first argument of ‘MkN’ + does not have a fixed runtime representation. + Its type is: + a :: TYPE (RR T1 t2) + • In the expression: MkN + In an equation for ‘bar’: bar = MkN diff --git a/testsuite/tests/rep-poly/UnliftedNewtypesCoerceFail.stderr b/testsuite/tests/rep-poly/UnliftedNewtypesCoerceFail.stderr index cbb03c1d27..3484650c73 100644 --- a/testsuite/tests/rep-poly/UnliftedNewtypesCoerceFail.stderr +++ b/testsuite/tests/rep-poly/UnliftedNewtypesCoerceFail.stderr @@ -4,10 +4,6 @@ UnliftedNewtypesCoerceFail.hs:14:8: error: The first argument of ‘coerce’ does not have a fixed runtime representation. Its type is: - a0 :: TYPE c0 - Cannot unify ‘rep’ with the type variable ‘c0’ - because it is not a concrete ‘RuntimeRep’. + x :: TYPE rep • In the expression: coerce In an equation for ‘goof’: goof = coerce - • Relevant bindings include - goof :: x -> y (bound at UnliftedNewtypesCoerceFail.hs:14:1) diff --git a/testsuite/tests/rep-poly/UnliftedNewtypesLevityBinder.stderr b/testsuite/tests/rep-poly/UnliftedNewtypesLevityBinder.stderr index bd4b2ba2ca..e0bdaa5e8c 100644 --- a/testsuite/tests/rep-poly/UnliftedNewtypesLevityBinder.stderr +++ b/testsuite/tests/rep-poly/UnliftedNewtypesLevityBinder.stderr @@ -1,12 +1,9 @@ UnliftedNewtypesLevityBinder.hs:15:7: error: - • The newtype constructor argument + • Unsaturated use of a representation-polymorphic newtype constructor. + The first argument of ‘IdentC’ does not have a fixed runtime representation. Its type is: - a0 :: TYPE c0 - Cannot unify ‘r’ with the type variable ‘c0’ - because it is not a concrete ‘RuntimeRep’. + a :: TYPE r • In the expression: IdentC In an equation for ‘bad’: bad = IdentC - • Relevant bindings include - bad :: a -> Ident a (bound at UnliftedNewtypesLevityBinder.hs:15:1) diff --git a/testsuite/tests/rep-poly/all.T b/testsuite/tests/rep-poly/all.T index c37289e568..39c9bed7ae 100644 --- a/testsuite/tests/rep-poly/all.T +++ b/testsuite/tests/rep-poly/all.T @@ -28,11 +28,9 @@ test('T20423', normal, compile_fail, ['']) test('T20423b', normal, compile_fail, ['']) test('T20426', normal, compile_fail, ['']) test('T21239', normal, compile, ['']) +test('T21544', normal, compile, ['-Wno-deprecated-flags']) test('EtaExpandDataCon', normal, compile, ['-O']) -test('EtaExpandDataFamily', expect_broken(21544), compile, ['']) -test('EtaExpandNewtypeTF', expect_broken(21650), compile, ['-Wno-deprecated-flags']) -test('EtaExpandNewtypeTF2', expect_broken(21650), compile, ['-Wno-deprecated-flags']) test('EtaExpandStupid1', normal, compile, ['-Wno-deprecated-flags']) test('EtaExpandStupid2', normal, compile_fail, ['-Wno-deprecated-flags']) test('LevPolyLet', normal, compile_fail, ['']) @@ -83,31 +81,35 @@ test('RepPolyTupleSection', normal, compile_fail, ['']) test('RepPolyUnboxedPatterns', normal, compile_fail, ['']) test('RepPolyUnliftedDatatype', normal, compile, ['']) test('RepPolyUnliftedDatatype2', normal, compile, ['-O']) +test('RepPolyUnliftedNewtype', normal, compile, + ['-fno-warn-partial-type-signatures -fno-warn-deprecated-flags']) test('RepPolyWildcardPattern', normal, compile_fail, ['']) test('RepPolyWrappedVar', normal, compile_fail, ['']) test('RepPolyWrappedVar2', normal, compile, ['']) test('UnliftedNewtypesCoerceFail', normal, compile_fail, ['']) test('UnliftedNewtypesLevityBinder', normal, compile_fail, ['']) -###################################################################### -## The following tests require rewriting in RuntimeReps, ## -## i.e. PHASE 2 of the FixedRuntimeRep plan. ## -## ## -## These tests work! ## - ## -test('T13105', normal, compile, ['']) ## -test('T17536b', normal, compile, ['']) ## - ## -## These don't! ## -## For the moment, we check that we get the expected error message, ## -## as we want to reject these in the typechecker instead of getting ## -## a compiler crash. ## - ## -test('T17021', normal, compile_fail, ['']) ## -test('T20363', normal, compile_fail, ['']) ## -test('T20363_show_co', normal, compile_fail ## - , ['-fprint-explicit-coercions']) ## -test('T20363b', normal, compile_fail, ['']) ## -test('RepPolyCase2', normal, compile_fail, ['']) ## -test('RepPolyRule3', normal, compile_fail, ['']) ## -###################################################################### +############################################################################### +## The following tests require rewriting in RuntimeReps, ## +## i.e. PHASE 2 of the FixedRuntimeRep plan. ## +## ## +## These tests work! ## + ## +test('T13105', normal, compile, ['']) ## +test('T17536b', normal, compile, ['']) ## + ## +## These don't! ## +## For the moment, we check that we get the expected error message, ## +## as we want to reject these in the typechecker instead of getting ## +## a compiler crash. ## + ## +test('T17021', normal, compile_fail, ['']) ## +test('T20363', normal, compile_fail, ['']) ## +test('T20363_show_co', normal, compile_fail, ['-fprint-explicit-coercions']) ## +test('T20363b', normal, compile_fail, ['']) ## +test('RepPolyCase2', normal, compile_fail, ['']) ## +test('RepPolyRule3', normal, compile_fail, ['']) ## +test('RepPolyTuple2', normal, compile_fail, ['']) ## see #21683 ## +test('T21650_a', normal, compile_fail, ['-Wno-deprecated-flags']) ## +test('T21650_b', normal, compile_fail, ['-Wno-deprecated-flags']) ## +############################################################################### |