diff options
Diffstat (limited to 'testsuite')
71 files changed, 717 insertions, 187 deletions
diff --git a/testsuite/tests/deSugar/should_compile/T2431.stderr b/testsuite/tests/deSugar/should_compile/T2431.stderr index f8c5a0ac9c..6786117295 100644 --- a/testsuite/tests/deSugar/should_compile/T2431.stderr +++ b/testsuite/tests/deSugar/should_compile/T2431.stderr @@ -9,8 +9,8 @@ T2431.$WRefl [InlPrag=INLINE] :: forall a. a T2431.:~: a Unf=Unf{Src=InlineStable, TopLvl=True, Arity=0, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(unsat_ok=False,boring_ok=False) - Tmpl= \ (@ a) -> T2431.Refl @ a @ a @~ <a>}] -T2431.$WRefl = \ (@ a) -> T2431.Refl @ a @ a @~ <a> + Tmpl= \ (@ a) -> T2431.Refl @ a @ a @~ <a>_N}] +T2431.$WRefl = \ (@ a) -> T2431.Refl @ a @ a @~ <a>_N T2431.absurd :: forall a. (GHC.Types.Int T2431.:~: GHC.Types.Bool) -> a diff --git a/testsuite/tests/deriving/should_compile/Roles1.hs b/testsuite/tests/deriving/should_compile/Roles1.hs new file mode 100644 index 0000000000..d0467c1a90 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/Roles1.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE RoleAnnotations, PolyKinds #-} + +module Roles1 where + +data T1 a@N = K1 a +data T2 a@R = K2 a +data T3 (a :: k)@P = K3 +data T4 (a :: * -> *)@N b = K4 (a b) + +data T5 a = K5 a +data T6 a = K6 +data T7 a b = K7 b + diff --git a/testsuite/tests/deriving/should_compile/Roles1.stderr b/testsuite/tests/deriving/should_compile/Roles1.stderr new file mode 100644 index 0000000000..10edab13ef --- /dev/null +++ b/testsuite/tests/deriving/should_compile/Roles1.stderr @@ -0,0 +1,50 @@ +TYPE SIGNATURES +TYPE CONSTRUCTORS + T1 :: * -> * + data T1 a@N + No C type associated + RecFlag NonRecursive, Promotable + = K1 :: forall a. a -> T1 a Stricts: _ + FamilyInstance: none + T2 :: * -> * + data T2 a@R + No C type associated + RecFlag NonRecursive, Promotable + = K2 :: forall a. a -> T2 a Stricts: _ + FamilyInstance: none + T3 :: forall (k :: BOX). k -> * + data T3 (k::BOX)@N (a::k)@P + No C type associated + RecFlag NonRecursive, Not promotable + = K3 :: forall (k::BOX) (a::k). T3 k a + FamilyInstance: none + T4 :: (* -> *) -> * -> * + data T4 (a::* -> *)@N b@N + No C type associated + RecFlag NonRecursive, Not promotable + = K4 :: forall (a::* -> *) b. (a b) -> T4 a b Stricts: _ + FamilyInstance: none + T5 :: * -> * + data T5 a@R + No C type associated + RecFlag NonRecursive, Promotable + = K5 :: forall a. a -> T5 a Stricts: _ + FamilyInstance: none + T6 :: forall (k :: BOX). k -> * + data T6 (k::BOX)@N (a::k)@P + No C type associated + RecFlag NonRecursive, Not promotable + = K6 :: forall (k::BOX) (a::k). T6 k a + FamilyInstance: none + T7 :: forall (k :: BOX). k -> * -> * + data T7 (k::BOX)@N (a::k)@P b@R + No C type associated + RecFlag NonRecursive, Not promotable + = K7 :: forall (k::BOX) (a::k) b. b -> T7 k a b Stricts: _ + FamilyInstance: none +COERCION AXIOMS +Dependent modules: [] +Dependent packages: [base, ghc-prim, integer-gmp] + +==================== Typechecker ==================== + diff --git a/testsuite/tests/deriving/should_compile/Roles13.hs b/testsuite/tests/deriving/should_compile/Roles13.hs new file mode 100644 index 0000000000..70d4c0c7d0 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/Roles13.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving, + MultiParamTypeClasses, FunctionalDependencies #-} + +-- tests axiom roles + +module Roles13 where + +newtype Age = MkAge Int +newtype Wrap a = MkWrap a + +convert :: Wrap Age -> Int +convert (MkWrap (MkAge i)) = i diff --git a/testsuite/tests/deriving/should_compile/Roles13.stderr b/testsuite/tests/deriving/should_compile/Roles13.stderr new file mode 100644 index 0000000000..647e59ba51 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/Roles13.stderr @@ -0,0 +1,20 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core = {terms: 5, types: 9, coercions: 5} + +a :: Roles13.Wrap Roles13.Age -> Roles13.Wrap Roles13.Age +[GblId, Arity=1, Caf=NoCafRefs, Str=DmdType] +a = \ (ds :: Roles13.Wrap Roles13.Age) -> ds + +Roles13.convert :: Roles13.Wrap Roles13.Age -> GHC.Types.Int +[GblId, Arity=1, Caf=NoCafRefs, Str=DmdType] +Roles13.convert = + a + `cast` (<Roles13.Wrap Roles13.Age>_R + -> Roles13.NTCo:Wrap[0] Roles13.NTCo:Age[0] + :: (Roles13.Wrap Roles13.Age -> Roles13.Wrap Roles13.Age) + ~# + (Roles13.Wrap Roles13.Age -> GHC.Types.Int)) + + + diff --git a/testsuite/tests/deriving/should_compile/Roles2.hs b/testsuite/tests/deriving/should_compile/Roles2.hs new file mode 100644 index 0000000000..1ead5a4e94 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/Roles2.hs @@ -0,0 +1,9 @@ +module Roles2 where + +import GHC.Ptr + +-- these *must* have certain roles, or things break strangely +-- see TcForeign + +data T1 a = K1 (IO a) +data T2 a = K2 (FunPtr a) diff --git a/testsuite/tests/deriving/should_compile/Roles2.stderr b/testsuite/tests/deriving/should_compile/Roles2.stderr new file mode 100644 index 0000000000..2dcf28e3bf --- /dev/null +++ b/testsuite/tests/deriving/should_compile/Roles2.stderr @@ -0,0 +1,20 @@ +TYPE SIGNATURES +TYPE CONSTRUCTORS + T1 :: * -> * + data T1 a@R + No C type associated + RecFlag NonRecursive, Not promotable + = K1 :: forall a. (IO a) -> T1 a Stricts: _ + FamilyInstance: none + T2 :: * -> * + data T2 a@R + No C type associated + RecFlag NonRecursive, Not promotable + = K2 :: forall a. (FunPtr a) -> T2 a Stricts: _ + FamilyInstance: none +COERCION AXIOMS +Dependent modules: [] +Dependent packages: [base, ghc-prim, integer-gmp] + +==================== Typechecker ==================== + diff --git a/testsuite/tests/deriving/should_compile/Roles3.hs b/testsuite/tests/deriving/should_compile/Roles3.hs new file mode 100644 index 0000000000..4c26f0d986 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/Roles3.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-} + +module Roles3 where + +class C1 a where + meth1 :: a -> a + +class C2 a b where + meth2 :: a ~ b => a -> b + +class C3 a b where + type F3 b + meth3 :: a -> F3 b -> F3 b + +type family F4 a + +class C4 a b where + meth4 :: a -> F4 b -> F4 b + +type Syn1 a = F4 a +type Syn2 a = [a]
\ No newline at end of file diff --git a/testsuite/tests/deriving/should_compile/Roles3.stderr b/testsuite/tests/deriving/should_compile/Roles3.stderr new file mode 100644 index 0000000000..1b187f4907 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/Roles3.stderr @@ -0,0 +1,35 @@ +TYPE SIGNATURES +TYPE CONSTRUCTORS + C1 :: * -> Constraint + class C1 a@R + RecFlag NonRecursive + meth1 :: a -> a + C2 :: * -> * -> Constraint + class C2 a@N b@N + RecFlag NonRecursive + meth2 :: (~) * a b -> a -> b + C3 :: * -> * -> Constraint + class C3 a@R b@N + RecFlag NonRecursive + type family F3 b@N :: * + meth3 :: a -> F3 b -> F3 b + C4 :: * -> * -> Constraint + class C4 a@R b@N + RecFlag NonRecursive + meth4 :: a -> F4 b -> F4 b + F4 :: * -> * + type family F4 a@N :: * + Syn1 :: * -> * + type Syn1 a@N = F4 a + Syn2 :: * -> * + type Syn2 a@R = [a] +COERCION AXIOMS + axiom Roles3.NTCo:C1 :: C1 a = a -> a + axiom Roles3.NTCo:C2 :: C2 a b = a ~ b => a -> b + axiom Roles3.NTCo:C3 :: C3 a b = a -> F3 b -> F3 b + axiom Roles3.NTCo:C4 :: C4 a b = a -> F4 b -> F4 b +Dependent modules: [] +Dependent packages: [base, ghc-prim, integer-gmp] + +==================== Typechecker ==================== + diff --git a/testsuite/tests/deriving/should_compile/Roles4.hs b/testsuite/tests/deriving/should_compile/Roles4.hs new file mode 100644 index 0000000000..32cb65a7df --- /dev/null +++ b/testsuite/tests/deriving/should_compile/Roles4.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE RoleAnnotations #-} + +module Roles4 where + +class C1 a@N where + meth1 :: a -> a + +class C2 a@R where + meth2 :: a -> a + +type Syn1 a@N = [a] + +class C3 a where + meth3 :: a -> Syn1 a + diff --git a/testsuite/tests/deriving/should_compile/Roles4.stderr b/testsuite/tests/deriving/should_compile/Roles4.stderr new file mode 100644 index 0000000000..9969cbca12 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/Roles4.stderr @@ -0,0 +1,25 @@ +TYPE SIGNATURES +TYPE CONSTRUCTORS + C1 :: * -> Constraint + class C1 a@N + RecFlag NonRecursive + meth1 :: a -> a + C2 :: * -> Constraint + class C2 a@R + RecFlag NonRecursive + meth2 :: a -> a + C3 :: * -> Constraint + class C3 a@N + RecFlag NonRecursive + meth3 :: a -> Syn1 a + Syn1 :: * -> * + type Syn1 a@N = [a] +COERCION AXIOMS + axiom Roles4.NTCo:C1 :: C1 a = a -> a + axiom Roles4.NTCo:C2 :: C2 a = a -> a + axiom Roles4.NTCo:C3 :: C3 a = a -> Syn1 a +Dependent modules: [] +Dependent packages: [base, ghc-prim, integer-gmp] + +==================== Typechecker ==================== + diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T index 07df602a20..e8fa8fe88d 100644 --- a/testsuite/tests/deriving/should_compile/all.T +++ b/testsuite/tests/deriving/should_compile/all.T @@ -39,4 +39,10 @@ test('T1133', test('T7704', normal, compile, ['']) test('T7710', normal, compile, ['']) -test('AutoDeriveTypeable', normal, compile, [''])
\ No newline at end of file +test('AutoDeriveTypeable', normal, compile, ['']) + +test('Roles1', only_ways('normal'), compile, ['-ddump-tc']) +test('Roles2', only_ways('normal'), compile, ['-ddump-tc']) +test('Roles3', only_ways('normal'), compile, ['-ddump-tc']) +test('Roles4', only_ways('normal'), compile, ['-ddump-tc']) +test('Roles13', only_ways('normal'), compile, ['-ddump-simpl -dsuppress-uniques'])
\ No newline at end of file diff --git a/testsuite/tests/deriving/should_fail/Makefile b/testsuite/tests/deriving/should_fail/Makefile index 629e011255..7e68e3840e 100644 --- a/testsuite/tests/deriving/should_fail/Makefile +++ b/testsuite/tests/deriving/should_fail/Makefile @@ -6,8 +6,11 @@ drvfail016: $(RM) -f drvfail016.hi-boot drvfail016.o-boot '$(TEST_HC)' $(TEST_HC_OPTS) -XGeneralizedNewtypeDeriving -c drvfail016.hs-boot; echo $$? -.PHONY: T1133A +.PHONY: T1133A Roles12 T1133A: '$(TEST_HC)' $(TEST_HC_OPTS) -c T1133A.hs-boot -'$(TEST_HC)' $(TEST_HC_OPTS) -c T1133A.hs +Roles12: + '$(TEST_HC)' $(TEST_HC_OPTS) -c Roles12.hs-boot + -'$(TEST_HC)' $(TEST_HC_OPTS) -c Roles12.hs diff --git a/testsuite/tests/deriving/should_fail/Roles10.hs b/testsuite/tests/deriving/should_fail/Roles10.hs new file mode 100644 index 0000000000..af19bfdf31 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/Roles10.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-} + +module Roles10 where + +type family F a +type instance F Int = Bool +type instance F Age = Char + +class C a where + meth :: a -> F a + +instance C Int where + meth = (> 0) + +newtype Age = MkAge Int + deriving C
\ No newline at end of file diff --git a/testsuite/tests/deriving/should_fail/Roles10.stderr b/testsuite/tests/deriving/should_fail/Roles10.stderr new file mode 100644 index 0000000000..caf83fc478 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/Roles10.stderr @@ -0,0 +1,7 @@ + +Roles10.hs:16:12: + Can't make a derived instance of ‛C Age’ + (even with cunning newtype deriving): + it is not type-safe to use GeneralizedNewtypeDeriving on this class; + the last parameter of ‛C’ is at role N + In the newtype declaration for ‛Age’ diff --git a/testsuite/tests/deriving/should_fail/Roles11.hs b/testsuite/tests/deriving/should_fail/Roles11.hs new file mode 100644 index 0000000000..c95cee798d --- /dev/null +++ b/testsuite/tests/deriving/should_fail/Roles11.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE GADTs, RoleAnnotations #-} + +module Roles11 where + +data T2 a@R where + K2 :: T2 Int + diff --git a/testsuite/tests/deriving/should_fail/Roles11.stderr b/testsuite/tests/deriving/should_fail/Roles11.stderr new file mode 100644 index 0000000000..5a3ad69e53 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/Roles11.stderr @@ -0,0 +1,5 @@ + +Roles11.hs:5:1: + Role mismatch on variable a: + Annotation says R but role N is required + In the data declaration for ‛T2’ diff --git a/testsuite/tests/deriving/should_fail/Roles12.hs b/testsuite/tests/deriving/should_fail/Roles12.hs new file mode 100644 index 0000000000..875d105b78 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/Roles12.hs @@ -0,0 +1,5 @@ +module Roles12 where + +import {-# SOURCE #-} Roles12 + +data T a diff --git a/testsuite/tests/deriving/should_fail/Roles12.hs-boot b/testsuite/tests/deriving/should_fail/Roles12.hs-boot new file mode 100644 index 0000000000..6a708d984a --- /dev/null +++ b/testsuite/tests/deriving/should_fail/Roles12.hs-boot @@ -0,0 +1,3 @@ +module Roles12 where + +data T a
\ No newline at end of file diff --git a/testsuite/tests/deriving/should_fail/Roles12.stderr b/testsuite/tests/deriving/should_fail/Roles12.stderr new file mode 100644 index 0000000000..e7f9329f6a --- /dev/null +++ b/testsuite/tests/deriving/should_fail/Roles12.stderr @@ -0,0 +1,12 @@ + +Roles12.hs:5:6: + Type constructor ‛T’ has conflicting definitions in the module and its hs-boot file + Main module: data T a@P + No C type associated + RecFlag Recursive, Promotable + = + FamilyInstance: none + Boot file: abstract(False) T a@R + No C type associated + RecFlag NonRecursive, Not promotable + FamilyInstance: none diff --git a/testsuite/tests/deriving/should_fail/Roles5.hs b/testsuite/tests/deriving/should_fail/Roles5.hs new file mode 100644 index 0000000000..8fe983ccb9 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/Roles5.hs @@ -0,0 +1,5 @@ +module Roles5 where + +data T a@N +class C a@R +type S a@P = Int
\ No newline at end of file diff --git a/testsuite/tests/deriving/should_fail/Roles5.stderr b/testsuite/tests/deriving/should_fail/Roles5.stderr new file mode 100644 index 0000000000..2a58a8a0ed --- /dev/null +++ b/testsuite/tests/deriving/should_fail/Roles5.stderr @@ -0,0 +1,15 @@ + +Roles5.hs:3:8: + Illegal role annotation + Perhaps you intended to use -XRoleAnnotations + In the data type declaration for ‛T’ + +Roles5.hs:4:9: + Illegal role annotation + Perhaps you intended to use -XRoleAnnotations + In the declaration for class C + +Roles5.hs:5:8: + Illegal role annotation + Perhaps you intended to use -XRoleAnnotations + In the declaration for type synonym ‛S’ diff --git a/testsuite/tests/deriving/should_fail/Roles6.hs b/testsuite/tests/deriving/should_fail/Roles6.hs new file mode 100644 index 0000000000..56f80a1e2b --- /dev/null +++ b/testsuite/tests/deriving/should_fail/Roles6.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE RoleAnnotations, TypeFamilies #-} + +module Roles6 where + +type family F a@R diff --git a/testsuite/tests/deriving/should_fail/Roles6.stderr b/testsuite/tests/deriving/should_fail/Roles6.stderr new file mode 100644 index 0000000000..4b89a9e40a --- /dev/null +++ b/testsuite/tests/deriving/should_fail/Roles6.stderr @@ -0,0 +1,5 @@ + +Roles6.hs:5:1: + Illegal role annotation on variable a; + role annotations are not allowed here + In the family declaration for ‛F’ diff --git a/testsuite/tests/deriving/should_fail/Roles7.hs b/testsuite/tests/deriving/should_fail/Roles7.hs new file mode 100644 index 0000000000..5d62803e3a --- /dev/null +++ b/testsuite/tests/deriving/should_fail/Roles7.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE RoleAnnotations #-} + +module Roles7 where + +bar :: Int@P -> Int +bar = id
\ No newline at end of file diff --git a/testsuite/tests/deriving/should_fail/Roles7.stderr b/testsuite/tests/deriving/should_fail/Roles7.stderr new file mode 100644 index 0000000000..5e527a69f7 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/Roles7.stderr @@ -0,0 +1,4 @@ + +Roles7.hs:5:8: + Illegal role annotation on Int + In the type signature for ‛bar’ diff --git a/testsuite/tests/deriving/should_fail/Roles8.hs b/testsuite/tests/deriving/should_fail/Roles8.hs new file mode 100644 index 0000000000..b05cf5dad4 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/Roles8.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE RoleAnnotations, GADTs #-} + +module Roles8 where + +data T1 a@P = K1 a diff --git a/testsuite/tests/deriving/should_fail/Roles8.stderr b/testsuite/tests/deriving/should_fail/Roles8.stderr new file mode 100644 index 0000000000..a650a66a30 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/Roles8.stderr @@ -0,0 +1,5 @@ + +Roles8.hs:5:1: + Role mismatch on variable a: + Annotation says P but role R is required + In the data declaration for ‛T1’ diff --git a/testsuite/tests/deriving/should_fail/Roles9.hs b/testsuite/tests/deriving/should_fail/Roles9.hs new file mode 100644 index 0000000000..86d10a3063 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/Roles9.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving, RoleAnnotations #-} + +module Roles9 where + +class C a@N where + meth :: a -> a + +instance C Int where + meth = (+ 1) + +newtype Age = MkAge Int + deriving C diff --git a/testsuite/tests/deriving/should_fail/Roles9.stderr b/testsuite/tests/deriving/should_fail/Roles9.stderr new file mode 100644 index 0000000000..611c377935 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/Roles9.stderr @@ -0,0 +1,7 @@ + +Roles9.hs:12:12: + Can't make a derived instance of ‛C Age’ + (even with cunning newtype deriving): + it is not type-safe to use GeneralizedNewtypeDeriving on this class; + the last parameter of ‛C’ is at role N + In the newtype declaration for ‛Age’ diff --git a/testsuite/tests/deriving/should_fail/T1496.hs b/testsuite/tests/deriving/should_fail/T1496.hs new file mode 100644 index 0000000000..35675ebd97 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T1496.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-} + +module T1496 where + +data family Z :: * -> * + +newtype instance Z Int = ZI Double +newtype instance Z Moo = ZM (Int,Int) + +newtype Moo = Moo Int deriving(IsInt) +class IsInt t where + isInt :: c Int -> c t + +instance IsInt Int where isInt = id + +main = case isInt (ZI 4.0) of ZM tu -> print tu
\ No newline at end of file diff --git a/testsuite/tests/deriving/should_fail/T1496.stderr b/testsuite/tests/deriving/should_fail/T1496.stderr new file mode 100644 index 0000000000..32a67a6e46 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T1496.stderr @@ -0,0 +1,7 @@ + +T1496.hs:10:32: + Can't make a derived instance of ‛IsInt Moo’ + (even with cunning newtype deriving): + it is not type-safe to use GeneralizedNewtypeDeriving on this class; + the last parameter of ‛IsInt’ is at role N + In the newtype declaration for ‛Moo’ diff --git a/testsuite/tests/deriving/should_fail/T2721.stderr b/testsuite/tests/deriving/should_fail/T2721.stderr index 64e93c3d12..375c8a4247 100644 --- a/testsuite/tests/deriving/should_fail/T2721.stderr +++ b/testsuite/tests/deriving/should_fail/T2721.stderr @@ -3,4 +3,6 @@ T2721.hs:15:28: Can't make a derived instance of ‛C N’ (even with cunning newtype deriving): the class has associated types + it is not type-safe to use GeneralizedNewtypeDeriving on this class; + the last parameter of ‛C’ is at role N In the newtype declaration for ‛N’ diff --git a/testsuite/tests/deriving/should_fail/T4846.hs b/testsuite/tests/deriving/should_fail/T4846.hs new file mode 100755 index 0000000000..66621c04ee --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T4846.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE RankNTypes, ScopedTypeVariables, StandaloneDeriving, GADTs, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
+
+module Main where
+
+import Data.Typeable
+
+data Expr a where
+ Lit :: Typeable a => a -> Expr a
+
+class A a where
+ mk :: a
+
+class (Typeable a, A a) => B a where
+ mkExpr :: Expr a
+ mkExpr = Lit mk
+
+-- dfunAE
+instance B a => A (Expr a) where
+ mk = mkExpr
+
+-- dfunAB
+instance A Bool where
+ mk = True
+
+newtype BOOL = BOOL Bool
+ deriving (Typeable, A)
+
+instance B Bool
+deriving instance B BOOL --dfunBB
+
+showType :: forall a . Expr a -> String
+showType (Lit _) = show (typeOf (undefined :: a))
+
+test1 = showType (mk :: Expr BOOL) -- Prints "Bool" (wrong?)
+test2 = showType (Lit mk :: Expr BOOL) -- Prints "Main.BOOL" (correct)
+
+main = do { print test1; print test2 }
diff --git a/testsuite/tests/deriving/should_fail/T4846.stderr b/testsuite/tests/deriving/should_fail/T4846.stderr new file mode 100644 index 0000000000..22556b0b6c --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T4846.stderr @@ -0,0 +1,7 @@ + +T4846.hs:29:1: + Can't make a derived instance of ‛B BOOL’ + (even with cunning newtype deriving): + it is not type-safe to use GeneralizedNewtypeDeriving on this class; + the last parameter of ‛B’ is at role N + In the stand-alone deriving instance for ‛B BOOL’ diff --git a/testsuite/tests/deriving/should_fail/T7148.hs b/testsuite/tests/deriving/should_fail/T7148.hs new file mode 100644 index 0000000000..1f91286e05 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T7148.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving, GADTs #-} + +module T7148 where + +data SameType a b where + Refl :: SameType a a + +coerce :: SameType a b -> a -> b +coerce Refl = id + +trans :: SameType a b -> SameType b c -> SameType a c +trans Refl Refl = Refl + +sameUnit :: SameType () () +sameUnit = Refl + + +class IsoUnit a where + iso1 :: SameType () b -> SameType a b + iso2 :: SameType b () -> SameType b a + +instance IsoUnit () where + iso1 = id + iso2 = id + + +newtype Tagged a b = Tagged b deriving IsoUnit + +sameTagged :: SameType (Tagged a b) (Tagged a' b') -> SameType a a' +sameTagged Refl = Refl + +unsafe' :: SameType (Tagged a ()) (Tagged a' ()) +unsafe' = (iso1 sameUnit) `trans` (iso2 sameUnit) + +unsafe :: SameType a b +unsafe = sameTagged unsafe' + +--once again inferred type is a -> b +unsafeCoerce = coerce unsafe
\ No newline at end of file diff --git a/testsuite/tests/deriving/should_fail/T7148.stderr b/testsuite/tests/deriving/should_fail/T7148.stderr new file mode 100644 index 0000000000..dcee25ff5f --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T7148.stderr @@ -0,0 +1,7 @@ + +T7148.hs:27:40: + Can't make a derived instance of ‛IsoUnit (Tagged a b)’ + (even with cunning newtype deriving): + it is not type-safe to use GeneralizedNewtypeDeriving on this class; + the last parameter of ‛IsoUnit’ is at role N + In the newtype declaration for ‛Tagged’ diff --git a/testsuite/tests/deriving/should_fail/T7148a.hs b/testsuite/tests/deriving/should_fail/T7148a.hs new file mode 100644 index 0000000000..6441058b24 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T7148a.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE TypeFamilies, ScopedTypeVariables, + GeneralizedNewtypeDeriving #-} + +module T7148a where + +import Control.Monad.ST +data Proxy a = Proxy +type family Result a b + +class Convert a where + coerce :: Proxy b -> a -> Result a b + +newtype SAFE a = SAFE a +type instance Result (SAFE a) b = a + +instance Convert (SAFE a) where + coerce _ (SAFE a) = a + +newtype IS_NO_LONGER a = IS_NO_LONGER a deriving Convert +type instance Result (IS_NO_LONGER a) b = b + +--infered type is +unsafeCoerce :: forall a b. a -> b +unsafeCoerce = coerce (Proxy :: Proxy b) . IS_NO_LONGER . SAFE + +--use it safely +id' :: a -> a +id' = unsafeCoerce + +--segfault (with high probability) +crash :: segfault +crash = unsafeCoerce . tail . tail . tail . unsafeCoerce $ True + + +--time for side effects +unsafePerformIO :: IO a -> a +unsafePerformIO x = runST $ unsafeCoerce x
\ No newline at end of file diff --git a/testsuite/tests/deriving/should_fail/T7148a.stderr b/testsuite/tests/deriving/should_fail/T7148a.stderr new file mode 100644 index 0000000000..f2a938c0a7 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T7148a.stderr @@ -0,0 +1,7 @@ + +T7148a.hs:19:50: + Can't make a derived instance of ‛Convert (IS_NO_LONGER a)’ + (even with cunning newtype deriving): + it is not type-safe to use GeneralizedNewtypeDeriving on this class; + the last parameter of ‛Convert’ is at role N + In the newtype declaration for ‛IS_NO_LONGER’ diff --git a/testsuite/tests/deriving/should_fail/all.T b/testsuite/tests/deriving/should_fail/all.T index c2d304ee19..610f1181fe 100644 --- a/testsuite/tests/deriving/should_fail/all.T +++ b/testsuite/tests/deriving/should_fail/all.T @@ -41,3 +41,18 @@ test('T1133A', ['$MAKE --no-print-directory -s T1133A']) test('T5863a', normal, compile_fail, ['']) test('T7959', normal, compile_fail, ['']) + +test('Roles5', normal, compile_fail, ['']) +test('Roles6', normal, compile_fail, ['']) +test('Roles7', normal, compile_fail, ['']) +test('Roles8', normal, compile_fail, ['']) +test('Roles9', normal, compile_fail, ['']) +test('Roles10', normal, compile_fail, ['']) +test('Roles11', normal, compile_fail, ['']) +test('Roles12', + extra_clean(['Roles12.o-boot', 'Roles12.hi-boot']), + run_command, ['$MAKE --no-print-directory -s Roles12']) +test('T1496', normal, compile_fail, ['']) +test('T4846', normal, compile_fail, ['']) +test('T7148', normal, compile_fail, ['']) +test('T7148a', normal, compile_fail, ['']) diff --git a/testsuite/tests/gadt/CasePrune.stderr b/testsuite/tests/gadt/CasePrune.stderr new file mode 100644 index 0000000000..8057e16653 --- /dev/null +++ b/testsuite/tests/gadt/CasePrune.stderr @@ -0,0 +1,7 @@ + +CasePrune.hs:14:31: + Can't make a derived instance of ‛C A’ + (even with cunning newtype deriving): + it is not type-safe to use GeneralizedNewtypeDeriving on this class; + the last parameter of ‛C’ is at role N + In the newtype declaration for ‛A’ diff --git a/testsuite/tests/gadt/CasePrune.stdout b/testsuite/tests/gadt/CasePrune.stdout deleted file mode 100644 index 52c33a57c7..0000000000 --- a/testsuite/tests/gadt/CasePrune.stdout +++ /dev/null @@ -1 +0,0 @@ -"ok" diff --git a/testsuite/tests/gadt/all.T b/testsuite/tests/gadt/all.T index 1be8260363..d23d1fc1b4 100644 --- a/testsuite/tests/gadt/all.T +++ b/testsuite/tests/gadt/all.T @@ -88,7 +88,7 @@ test('gadt-escape1', normal, compile_fail, ['']) # test('Arith', normal, compile, ['']) test('Session', normal, compile_and_run, ['']) -test('CasePrune', normal, compile_and_run, ['']) +test('CasePrune', normal, compile_fail, ['']) test('T1999', normal, compile, ['']) test('T1999a', normal, compile, ['']) diff --git a/testsuite/tests/gadt/gadt11.hs b/testsuite/tests/gadt/gadt11.hs index a5000442fa..c0e176f1ff 100644 --- a/testsuite/tests/gadt/gadt11.hs +++ b/testsuite/tests/gadt/gadt11.hs @@ -3,10 +3,11 @@ module ShouldFail where -- Wrong return type -data X f = X (f ()) - -data B a where - B1 :: X [] - B2 :: B [Int] +data T1 a where + K1 :: T1 Int + K2 :: T2 Int -> T1 Bool +data T2 a where + L1 :: T2 Int + L2 :: T1 Bool diff --git a/testsuite/tests/gadt/gadt11.stderr b/testsuite/tests/gadt/gadt11.stderr index 96f636c0a6..b753bd961c 100644 --- a/testsuite/tests/gadt/gadt11.stderr +++ b/testsuite/tests/gadt/gadt11.stderr @@ -1,6 +1,6 @@ -gadt11.hs:9:3: - Data constructor ‛B1’ returns type ‛X []’ - instead of an instance of its parent type ‛B a’ - In the definition of data constructor ‛B1’ - In the data declaration for ‛B’ +gadt11.hs:12:3: + Data constructor ‛L2’ returns type ‛T1 Bool’ + instead of an instance of its parent type ‛T2 a’ + In the definition of data constructor ‛L2’ + In the data declaration for ‛T2’ diff --git a/testsuite/tests/indexed-types/should_compile/T3017.stderr b/testsuite/tests/indexed-types/should_compile/T3017.stderr index 5c6a2641c7..f8e8292313 100644 --- a/testsuite/tests/indexed-types/should_compile/T3017.stderr +++ b/testsuite/tests/indexed-types/should_compile/T3017.stderr @@ -4,12 +4,12 @@ TYPE SIGNATURES forall c t t1. (Num t, Num t1, Coll c, Elem c ~ (t, t1)) => c -> c TYPE CONSTRUCTORS Coll :: * -> Constraint - class Coll c + class Coll c@N RecFlag NonRecursive - type family Elem c :: * + type family Elem c@N :: * empty :: c insert :: Elem c -> c -> c ListColl :: * -> * - data ListColl a + data ListColl a@R No C type associated RecFlag NonRecursive, Promotable = L :: forall a. [a] -> ListColl a Stricts: _ diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 9b58d1bc77..8f23c0c29f 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -180,18 +180,20 @@ test('T3064', [(wordsize(32), 111189536, 10), # expected value: 56380288 (x86/Linux) (28/6/2011) # 111189536 (x86/Windows) (30/10/12) - (wordsize(64), 224798696, 5)]), + (wordsize(64), 236404384, 5)]), # (amd64/Linux) (28/06/2011): 73259544 # (amd64/Linux) (07/02/2013): 224798696 + # (amd64/Linux) (02/08/2013): 236404384, increase from roles compiler_stats_num_field('max_bytes_used', [(wordsize(32), 5511604, 20), # expected value: 2247016 (x86/Linux) (28/6/2011): - (wordsize(64), 9397488, 10)]), + (wordsize(64), 10742536, 10)]), # (amd64/Linux, intree) (28/06/2011): 4032024 # (amd64/Linux, intree) (07/02/2013): 9819288 # (amd64/Linux) (14/02/2013): 8687360 # (amd64/Linux) (18/02/2013): 9397488 + # (amd64/Linux) (02/08/2013): 10742536, increase from roles only_ways(['normal']) ], compile, @@ -207,12 +209,14 @@ test('T5030', [(wordsize(32), 259547660, 10), # previous: 196457520 # 2012-10-08: 259547660 (x86/Linux, new codegen) - (wordsize(64), 538467496, 10)]), + (wordsize(64), 454498592, 10)]), # Previously 530000000 (+/- 10%) # 17/1/13: 602993184 (x86_64/Linux) # (new demand analyser) # 2013-06-08 538467496 (x86_64/Linux) # ^ reason unknown + # 2013-08-02 454498592 (amd64/Linux) + # decrease from more aggressive coercion optimisations from roles only_ways(['normal']) ], diff --git a/testsuite/tests/polykinds/T7272.hs-boot b/testsuite/tests/polykinds/T7272.hs-boot index fa46e1e463..0fcc02f71b 100644 --- a/testsuite/tests/polykinds/T7272.hs-boot +++ b/testsuite/tests/polykinds/T7272.hs-boot @@ -1,5 +1,5 @@ -{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE PolyKinds, RoleAnnotations #-}
module T7272 where
-class C (a :: k)
+class C (a :: k)@P
diff --git a/testsuite/tests/rename/should_compile/Imp100Aux.hs-boot b/testsuite/tests/rename/should_compile/Imp100Aux.hs-boot index 934db61841..b197c47805 100644 --- a/testsuite/tests/rename/should_compile/Imp100Aux.hs-boot +++ b/testsuite/tests/rename/should_compile/Imp100Aux.hs-boot @@ -1,11 +1,12 @@ +{-# LANGUAGE RoleAnnotations #-} module Imp100Aux where -data T1 a -data T2 a b -data T3 a b c -data T4 a b c d -data T5 a b c d e -data T6 a -data T7 a b -data T8 a b c -data T9 a b c d -data T10 a b c d e +data T1 a@P +data T2 a@P b@P +data T3 a@P b@P c@P +data T4 a@P b@P c@P d@P +data T5 a@P b@P c@P d@P e@P +data T6 a@P +data T7 a@P b@P +data T8 a@P b@P c@P +data T9 a@P b@P c@P d@P +data T10 a@P b@P c@P d@P e@P diff --git a/testsuite/tests/rename/should_compile/Imp10Aux.hs-boot b/testsuite/tests/rename/should_compile/Imp10Aux.hs-boot index 248c113ba2..cfe980e2f0 100644 --- a/testsuite/tests/rename/should_compile/Imp10Aux.hs-boot +++ b/testsuite/tests/rename/should_compile/Imp10Aux.hs-boot @@ -1,11 +1,13 @@ +{-# LANGUAGE RoleAnnotations #-} + module Imp10Aux where -data T1 a -data T2 a b -data T3 a b c -data T4 a b c d -data T5 a b c d e -data T6 a -data T7 a b -data T8 a b c -data T9 a b c d -data T10 a b c d e +data T1 a@P +data T2 a@P b@P +data T3 a@P b@P c@P +data T4 a@P b@P c@P d@P +data T5 a@P b@P c@P d@P e@P +data T6 a@P +data T7 a@P b@P +data T8 a@P b@P c@P +data T9 a@P b@P c@P d@P +data T10 a@P b@P c@P d@P e@P diff --git a/testsuite/tests/rename/should_compile/Imp500Aux.hs-boot b/testsuite/tests/rename/should_compile/Imp500Aux.hs-boot index 251ac8012c..9dc4ea2a74 100644 --- a/testsuite/tests/rename/should_compile/Imp500Aux.hs-boot +++ b/testsuite/tests/rename/should_compile/Imp500Aux.hs-boot @@ -1,11 +1,12 @@ +{-# LANGUAGE RoleAnnotations #-} module Imp500Aux where -data T1 a -data T2 a b -data T3 a b c -data T4 a b c d -data T5 a b c d e -data T6 a -data T7 a b -data T8 a b c -data T9 a b c d -data T10 a b c d e +data T1 a@P +data T2 a@P b@P +data T3 a@P b@P c@P +data T4 a@P b@P c@P d@P +data T5 a@P b@P c@P d@P e@P +data T6 a@P +data T7 a@P b@P +data T8 a@P b@P c@P +data T9 a@P b@P c@P d@P +data T10 a@P b@P c@P d@P e@P diff --git a/testsuite/tests/rename/should_fail/rnfail055.stderr b/testsuite/tests/rename/should_fail/rnfail055.stderr index 992cfc5150..41a2bd095c 100644 --- a/testsuite/tests/rename/should_fail/rnfail055.stderr +++ b/testsuite/tests/rename/should_fail/rnfail055.stderr @@ -12,22 +12,22 @@ RnFail055.hs-boot:4:1: RnFail055.hs-boot:6:6: Type constructor ‛S1’ has conflicting definitions in the module and its hs-boot file - Main module: type S1 a b = (a, b) - Boot file: type S1 a b c = (a, b) + Main module: type S1 a@R b@R = (a, b) + Boot file: type S1 a@R b@R c@R = (a, b) RnFail055.hs-boot:8:6: Type constructor ‛S2’ has conflicting definitions in the module and its hs-boot file - Main module: type S2 a b = forall a1. (a1, b) - Boot file: type S2 a b = forall b1. (a, b1) + Main module: type S2 a@P b@R = forall a1. (a1, b) + Boot file: type S2 a@R b@R = forall b1. (a, b1) RnFail055.hs-boot:12:6: Type constructor ‛T1’ has conflicting definitions in the module and its hs-boot file - Main module: data T1 a b + Main module: data T1 a@R b@R No C type associated RecFlag Recursive, Promotable = T1 :: forall a b. [b] -> [a] -> T1 a b Stricts: _ _ FamilyInstance: none - Boot file: data T1 a b + Boot file: data T1 a@R b@R No C type associated RecFlag NonRecursive, Promotable = T1 :: forall a b. [a] -> [b] -> T1 a b Stricts: _ _ @@ -35,12 +35,12 @@ RnFail055.hs-boot:12:6: RnFail055.hs-boot:14:16: Type constructor ‛T2’ has conflicting definitions in the module and its hs-boot file - Main module: data Eq b => T2 a b + Main module: data Eq b => T2 a@R b@P No C type associated RecFlag Recursive, Promotable = T2 :: forall a b. a -> T2 a b Stricts: _ FamilyInstance: none - Boot file: data Eq a => T2 a b + Boot file: data Eq a => T2 a@R b@R No C type associated RecFlag NonRecursive, Promotable = T2 :: forall a b. a -> T2 a b Stricts: _ @@ -54,12 +54,12 @@ RnFail055.hs-boot:17:12: RnFail055.hs-boot:21:6: Type constructor ‛T5’ has conflicting definitions in the module and its hs-boot file - Main module: data T5 a + Main module: data T5 a@R No C type associated RecFlag Recursive, Promotable = T5 :: forall a. a -> T5 a Stricts: _ Fields: field5 FamilyInstance: none - Boot file: data T5 a + Boot file: data T5 a@R No C type associated RecFlag NonRecursive, Promotable = T5 :: forall a. a -> T5 a Stricts: _ @@ -80,12 +80,12 @@ RnFail055.hs-boot:23:6: RnFail055.hs-boot:25:6: Type constructor ‛T7’ has conflicting definitions in the module and its hs-boot file - Main module: data T7 a + Main module: data T7 a@P No C type associated RecFlag Recursive, Promotable = T7 :: forall a a1. a1 -> T7 a Stricts: _ FamilyInstance: none - Boot file: data T7 a + Boot file: data T7 a@R No C type associated RecFlag NonRecursive, Promotable = T7 :: forall a. a -> T7 a Stricts: _ @@ -96,14 +96,14 @@ RnFail055.hs-boot:27:22: RnFail055.hs-boot:28:7: Class ‛C2’ has conflicting definitions in the module and its hs-boot file - Main module: class C2 a b + Main module: class C2 a@R b@R RecFlag Recursive m2 :: a -> b m2' :: a -> b - Boot file: class C2 a b + Boot file: class C2 a@R b@R RecFlag NonRecursive m2 :: a -> b RnFail055.hs-boot:29:24: Class ‛C3’ has conflicting definitions in the module and its hs-boot file - Main module: class (Eq a, Ord a) => C3 a RecFlag Recursive - Boot file: class (Ord a, Eq a) => C3 a RecFlag NonRecursive + Main module: class (Eq a, Ord a) => C3 a@R RecFlag Recursive + Boot file: class (Ord a, Eq a) => C3 a@R RecFlag NonRecursive diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang06.hs b/testsuite/tests/safeHaskell/safeLanguage/SafeLang06.hs deleted file mode 100644 index 685846f150..0000000000 --- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang06.hs +++ /dev/null @@ -1,40 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - --- Here we allow it to succeed (No SAFE) - --- | We use newtype to create an isomorphic type to Int --- with a reversed Ord dictionary. We now use the MinList --- API of Y1 to create a new MinList. Then we use newtype --- deriving to convert the newtype MinList to an Int --- MinList. This final result breaks the invariants of --- MinList which shouldn't be possible with the exposed --- API of Y1. -module Main where - -import SafeLang06_A - -class IntIso t where - intIso :: c t -> c Int - -instance IntIso Int where - intIso = id - -newtype Down a = Down a deriving (Eq, Show, IntIso) - -instance Ord a => Ord (Down a) where - compare (Down a) (Down b) = compare b a - -forceInt :: MinList Int -> MinList Int -forceInt = id - -a1, a2 :: MinList Int -a1 = foldl insertMinList (newMinList $ head nums) (tail nums) -a2 = forceInt $ intIso $ foldl (\x y -> insertMinList x $ Down y) (newMinList $ Down $ head nums) (tail nums) - -nums :: [Int] -nums = [1,4,0,1,-5,2,3,5,-1,2,0,0,-4,-3,9] - -main = do - printIntMinList a1 - printIntMinList a2 - diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang06.stdout b/testsuite/tests/safeHaskell/safeLanguage/SafeLang06.stdout deleted file mode 100644 index ed005737b7..0000000000 --- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang06.stdout +++ /dev/null @@ -1,2 +0,0 @@ -MinList Int :: MinList 1 [9,2,5,3,2,4] -MinList Int :: MinList 1 [-3,-4,0,0,-1,-5,0] diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang06_A.hs b/testsuite/tests/safeHaskell/safeLanguage/SafeLang06_A.hs deleted file mode 100644 index d092ae7a1a..0000000000 --- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang06_A.hs +++ /dev/null @@ -1,24 +0,0 @@ -{-# LANGUAGE Trustworthy #-} - --- | Here we expose a MinList API that only allows elements --- to be inserted into a list if they are at least greater --- than an initial element the list is created with. -module SafeLang06_A ( - MinList, - newMinList, - insertMinList, - printIntMinList - ) where - -data MinList a = MinList a [a] - -newMinList :: Ord a => a -> MinList a -newMinList n = MinList n [] - -insertMinList :: Ord a => MinList a -> a -> MinList a -insertMinList s@(MinList m xs) n | n > m = MinList m (n:xs) - | otherwise = s - -printIntMinList :: MinList Int -> IO () -printIntMinList (MinList min xs) = putStrLn $ "MinList Int :: MinList " ++ show min ++ " " ++ show xs - diff --git a/testsuite/tests/safeHaskell/safeLanguage/all.T b/testsuite/tests/safeHaskell/safeLanguage/all.T index e2b5d1b656..5932348594 100644 --- a/testsuite/tests/safeHaskell/safeLanguage/all.T +++ b/testsuite/tests/safeHaskell/safeLanguage/all.T @@ -14,10 +14,11 @@ test('SafeLang02', normal, compile, ['']) test('SafeLang03', normal, compile, ['']) test('SafeLang04', normal, compile_and_run, ['']) test('SafeLang05', normal, compile_and_run, ['']) -test('SafeLang06', - extra_clean(['SafeLang06_A.o', 'SafeLang06_A.hi']), - compile_and_run, - ['']) + +# SafeLang06 was a test involving GeneralizedNewtypeDeriving, but the code +# fails to compile with roles; thus the test is no longer valid and has +# been removed + test('SafeLang07', normal, compile_fail, ['']) test('SafeLang08', normal, compile_fail, ['']) test('SafeLang09', diff --git a/testsuite/tests/simplCore/should_compile/T4201.stdout b/testsuite/tests/simplCore/should_compile/T4201.stdout index e93fbd6f12..ed519ed02f 100644 --- a/testsuite/tests/simplCore/should_compile/T4201.stdout +++ b/testsuite/tests/simplCore/should_compile/T4201.stdout @@ -1,3 +1,3 @@ {- Arity: 1, HasNoCafRefs, Strictness: <S,1*U()>m, Unfolding: InlineRule (0, True, True) - Eta.bof `cast` (Sym (Eta.NTCo:Foo[0]) -> Refl Eta.T) -} + Eta.bof `cast` (Sym (Eta.NTCo:Foo[0]) ->_R <Eta.T>_R) -} diff --git a/testsuite/tests/th/T1835.stdout b/testsuite/tests/th/T1835.stdout index ba8e65f418..cbe455bca1 100644 --- a/testsuite/tests/th/T1835.stdout +++ b/testsuite/tests/th/T1835.stdout @@ -1,4 +1,4 @@ -class GHC.Classes.Eq a_0 => Main.MyClass a_0 +class GHC.Classes.Eq a_0 => Main.MyClass a_0@R instance Main.MyClass Main.Foo instance Main.MyClass Main.Baz instance GHC.Classes.Eq a_1 => Main.MyClass (Main.Quux a_1) diff --git a/testsuite/tests/th/T4188.stderr b/testsuite/tests/th/T4188.stderr index 469a2d3840..187d902ac1 100644 --- a/testsuite/tests/th/T4188.stderr +++ b/testsuite/tests/th/T4188.stderr @@ -1,6 +1,6 @@ -data T4188.T1 a_0 = forall b_1 . T4188.MkT1 a_0 b_1
-data T4188.T2 a_0
- = forall b_1 . (T4188.C a_0, T4188.C b_1) => T4188.MkT2 a_0 b_1
-data T4188.T3 x_0
- = forall x_1 y_2 . (x_0 ~ (x_1, y_2), T4188.C x_1, T4188.C y_2) =>
- T4188.MkT3 x_1 y_2
+data T4188.T1 a_0@R = forall b_1 . T4188.MkT1 a_0 b_1 +data T4188.T2 a_0@R + = forall b_1 . (T4188.C a_0, T4188.C b_1) => T4188.MkT2 a_0 b_1 +data T4188.T3 x_0@N + = forall x_1 y_2 . (x_0 ~ (x_1, y_2), T4188.C x_1, T4188.C y_2) => + T4188.MkT3 x_1 y_2 diff --git a/testsuite/tests/th/TH_Roles1.hs b/testsuite/tests/th/TH_Roles1.hs new file mode 100644 index 0000000000..5829895f59 --- /dev/null +++ b/testsuite/tests/th/TH_Roles1.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TemplateHaskell #-} + +module TH_Roles1 where + +import Language.Haskell.TH + +$( return [DataD [] (mkName "T") [RoledTV (mkName "a") Representational] [] []] ) + diff --git a/testsuite/tests/th/TH_Roles1.stderr b/testsuite/tests/th/TH_Roles1.stderr new file mode 100644 index 0000000000..0b1ac3338c --- /dev/null +++ b/testsuite/tests/th/TH_Roles1.stderr @@ -0,0 +1,5 @@ + +TH_Roles1.hs:7:4: + Illegal role annotation + Perhaps you intended to use -XRoleAnnotations + In the data type declaration for ‛T’ diff --git a/testsuite/tests/th/TH_Roles2.hs b/testsuite/tests/th/TH_Roles2.hs new file mode 100644 index 0000000000..fc010df9ed --- /dev/null +++ b/testsuite/tests/th/TH_Roles2.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TemplateHaskell, RoleAnnotations, PolyKinds #-} + +module TH_Roles2 where + +import Language.Haskell.TH + +$( return [DataD [] (mkName "T") [KindedRoledTV (mkName "a") (VarT (mkName "k")) Representational] [] []] ) + diff --git a/testsuite/tests/th/TH_Roles2.stderr b/testsuite/tests/th/TH_Roles2.stderr new file mode 100644 index 0000000000..4d85768387 --- /dev/null +++ b/testsuite/tests/th/TH_Roles2.stderr @@ -0,0 +1,16 @@ +TYPE SIGNATURES +TYPE CONSTRUCTORS + T :: forall (k :: BOX). k -> * + data T (k::BOX)@N (a::k)@R + No C type associated + RecFlag NonRecursive, Not promotable + = + FamilyInstance: none +COERCION AXIOMS +Dependent modules: [] +Dependent packages: [array-0.4.0.2, base, containers-0.5.0.0, + deepseq-1.3.0.2, ghc-prim, integer-gmp, pretty-1.1.1.0, + template-haskell] + +==================== Typechecker ==================== + diff --git a/testsuite/tests/th/TH_Roles3.hs b/testsuite/tests/th/TH_Roles3.hs new file mode 100644 index 0000000000..355b1e595a --- /dev/null +++ b/testsuite/tests/th/TH_Roles3.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TemplateHaskell, PolyKinds, RoleAnnotations #-} + +module Roles3 where + +import Language.Haskell.TH + +$( do { decls <- [d| data Foo a (b :: k) c@R (d :: k)@N |] + ; reportWarning (pprint decls) + ; return decls }) diff --git a/testsuite/tests/th/TH_Roles3.stderr b/testsuite/tests/th/TH_Roles3.stderr new file mode 100644 index 0000000000..b1bfd20825 --- /dev/null +++ b/testsuite/tests/th/TH_Roles3.stderr @@ -0,0 +1,3 @@ + +TH_Roles3.hs:7:4: Warning: + data Foo_0 a_1 (b_2 :: k_3) c_4@R (d_5 :: k_3)@N diff --git a/testsuite/tests/th/TH_reifyDecl1.stderr b/testsuite/tests/th/TH_reifyDecl1.stderr index 82a4f572ce..0f44e4b862 100644 --- a/testsuite/tests/th/TH_reifyDecl1.stderr +++ b/testsuite/tests/th/TH_reifyDecl1.stderr @@ -1,9 +1,9 @@ data TH_reifyDecl1.T = TH_reifyDecl1.A | TH_reifyDecl1.B -data TH_reifyDecl1.R a_0 = TH_reifyDecl1.C a_0 | TH_reifyDecl1.D -data TH_reifyDecl1.List a_0 +data TH_reifyDecl1.R a_0@R = TH_reifyDecl1.C a_0 | TH_reifyDecl1.D +data TH_reifyDecl1.List a_0@R = TH_reifyDecl1.Nil | TH_reifyDecl1.Cons a_0 (TH_reifyDecl1.List a_0) -data TH_reifyDecl1.Tree a_0 +data TH_reifyDecl1.Tree a_0@P = TH_reifyDecl1.Leaf | (TH_reifyDecl1.Tree a_0) TH_reifyDecl1.:+: (TH_reifyDecl1.Tree a_0) type TH_reifyDecl1.IntList = [GHC.Types.Int] @@ -12,14 +12,14 @@ Constructor from TH_reifyDecl1.Tree: TH_reifyDecl1.Leaf :: forall a_0 . TH_reify Class op from TH_reifyDecl1.C1: TH_reifyDecl1.m1 :: forall a_0 . TH_reifyDecl1.C1 a_0 => a_0 -> GHC.Types.Int infixl 3 TH_reifyDecl1.m1 -class TH_reifyDecl1.C1 a_0 +class TH_reifyDecl1.C1 a_0@R where TH_reifyDecl1.m1 :: forall a_0 . TH_reifyDecl1.C1 a_0 => a_0 -> GHC.Types.Int -class TH_reifyDecl1.C2 a_0 +class TH_reifyDecl1.C2 a_0@R where TH_reifyDecl1.m2 :: forall a_0 . TH_reifyDecl1.C2 a_0 => a_0 -> GHC.Types.Int instance TH_reifyDecl1.C2 GHC.Types.Int -class TH_reifyDecl1.C3 a_0 +class TH_reifyDecl1.C3 a_0@N instance TH_reifyDecl1.C3 GHC.Types.Int type family TH_reifyDecl1.AT1 a_0 :: * -> * type instance TH_reifyDecl1.AT1 GHC.Types.Int = GHC.Types.Bool diff --git a/testsuite/tests/th/TH_reifyDecl2.stderr b/testsuite/tests/th/TH_reifyDecl2.stderr index 1beab4d9c3..65bbd75dd5 100644 --- a/testsuite/tests/th/TH_reifyDecl2.stderr +++ b/testsuite/tests/th/TH_reifyDecl2.stderr @@ -1,2 +1,2 @@ -data Data.Maybe.Maybe a_0 = Data.Maybe.Nothing - | Data.Maybe.Just a_0 +data Data.Maybe.Maybe a_0@R + = Data.Maybe.Nothing | Data.Maybe.Just a_0 diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 73d60af786..2840387675 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -281,3 +281,7 @@ test('T8028', extra_clean(['T8028a.hi', 'T8028a.o']), multimod_compile_fail, ['T8028', '-v0 ' + config.ghc_th_way_flags]) + +test('TH_Roles1', normal, compile_fail, ['-v0']) +test('TH_Roles2', normal, compile, ['-v0 -ddump-tc']) +test('TH_Roles3', normal, compile, ['-v0 -dsuppress-uniques'])
\ No newline at end of file diff --git a/testsuite/tests/typecheck/should_compile/tc231.stderr b/testsuite/tests/typecheck/should_compile/tc231.stderr index e8ebcc7ba8..92155f0588 100644 --- a/testsuite/tests/typecheck/should_compile/tc231.stderr +++ b/testsuite/tests/typecheck/should_compile/tc231.stderr @@ -1,29 +1,29 @@ -TYPE SIGNATURES
- foo ::
- forall s b chain.
- Zork s (Z [Char]) b =>
- Q s (Z [Char]) chain -> ST s ()
- s :: forall t t1. Q t (Z [Char]) t1 -> Q t (Z [Char]) t1
-TYPE CONSTRUCTORS
- Q :: * -> * -> * -> *
- data Q s a chain
- No C type associated
- RecFlag NonRecursive, Promotable
- = Node :: forall s a chain. s -> a -> chain -> Q s a chain
- Stricts: _ _ _
- FamilyInstance: none
- Z :: * -> *
- data Z a
- No C type associated
- RecFlag NonRecursive, Promotable
- = Z :: forall a. a -> Z a Stricts: _
- FamilyInstance: none
- Zork :: * -> * -> * -> Constraint
- class Zork s a b | a -> b
- RecFlag NonRecursive
- huh :: forall chain. Q s a chain -> ST s ()
-COERCION AXIOMS
- axiom ShouldCompile.NTCo:Zork ::
- Zork s a b = forall chain. Q s a chain -> ST s ()
-Dependent modules: []
-Dependent packages: [base, ghc-prim, integer-gmp]
+TYPE SIGNATURES + foo :: + forall s b chain. + Zork s (Z [Char]) b => + Q s (Z [Char]) chain -> ST s () + s :: forall t t1. Q t (Z [Char]) t1 -> Q t (Z [Char]) t1 +TYPE CONSTRUCTORS + Q :: * -> * -> * -> * + data Q s@R a@R chain@R + No C type associated + RecFlag NonRecursive, Promotable + = Node :: forall s a chain. s -> a -> chain -> Q s a chain + Stricts: _ _ _ + FamilyInstance: none + Z :: * -> * + data Z a@R + No C type associated + RecFlag NonRecursive, Promotable + = Z :: forall a. a -> Z a Stricts: _ + FamilyInstance: none + Zork :: * -> * -> * -> Constraint + class Zork s@N a@R b@P | a -> b + RecFlag NonRecursive + huh :: forall chain. Q s a chain -> ST s () +COERCION AXIOMS + axiom ShouldCompile.NTCo:Zork :: + Zork s a b = forall chain. Q s a chain -> ST s () +Dependent modules: [] +Dependent packages: [base, ghc-prim, integer-gmp] diff --git a/testsuite/tests/typecheck/should_fail/T3468.stderr b/testsuite/tests/typecheck/should_fail/T3468.stderr index 16450c14d4..e12db7a747 100644 --- a/testsuite/tests/typecheck/should_fail/T3468.stderr +++ b/testsuite/tests/typecheck/should_fail/T3468.stderr @@ -1,7 +1,7 @@ T3468.hs-boot:3:6: Type constructor ‛Tool’ has conflicting definitions in the module and its hs-boot file - Main module: data Tool d + Main module: data Tool d@P No C type associated RecFlag Recursive, Promotable = F :: forall d a. a -> Tool d Stricts: _ diff --git a/testsuite/tests/typecheck/should_fail/T7892.stderr b/testsuite/tests/typecheck/should_fail/T7892.stderr index eec7bd73dc..882aca64d6 100644 --- a/testsuite/tests/typecheck/should_fail/T7892.stderr +++ b/testsuite/tests/typecheck/should_fail/T7892.stderr @@ -1,2 +1,2 @@ -T7892.hs:5:4: Couldn't match kind ‛*’ against ‛* -> *’ +T7892.hs:5:4: Couldn't match kind ‛* -> *’ against ‛*’ |