diff options
Diffstat (limited to 'testsuite/tests/deriving/should_fail')
28 files changed, 302 insertions, 1 deletions
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, ['']) |