diff options
Diffstat (limited to 'testsuite/tests/ghc-regress/generics')
29 files changed, 0 insertions, 515 deletions
diff --git a/testsuite/tests/ghc-regress/generics/GEq/GEq.hs b/testsuite/tests/ghc-regress/generics/GEq/GEq.hs deleted file mode 100644 index 54caad34e5..0000000000 --- a/testsuite/tests/ghc-regress/generics/GEq/GEq.hs +++ /dev/null @@ -1,44 +0,0 @@ -{-# LANGUAGE TypeOperators, DefaultSignatures, FlexibleContexts, FlexibleInstances #-} - -module GEq where - -import GHC.Generics - -class GEq' f where - geq' :: f a -> f a -> Bool - -instance GEq' U1 where - geq' _ _ = True - -instance (GEq c) => GEq' (K1 i c) where - geq' (K1 a) (K1 b) = geq a b - --- No instances for P or Rec because geq is only applicable to types of kind * - -instance (GEq' a) => GEq' (M1 i c a) where - geq' (M1 a) (M1 b) = geq' a b - -instance (GEq' a, GEq' b) => GEq' (a :+: b) where - geq' (L1 a) (L1 b) = geq' a b - geq' (R1 a) (R1 b) = geq' a b - geq' _ _ = False - -instance (GEq' a, GEq' b) => GEq' (a :*: b) where - geq' (a1 :*: b1) (a2 :*: b2) = geq' a1 a2 && geq' b1 b2 - - -class GEq a where - geq :: a -> a -> Bool - default geq :: (Generic a, GEq' (Rep a)) => a -> a -> Bool - geq x y = geq' (from x) (from y) - - --- Base types instances (ad-hoc) -instance GEq Char where geq = (==) -instance GEq Int where geq = (==) -instance GEq Float where geq = (==) -{- --- Generic instances -instance (GEq a) => GEq (Maybe a) -instance (GEq a) => GEq [a] --} diff --git a/testsuite/tests/ghc-regress/generics/GEq/GEq1.stdout b/testsuite/tests/ghc-regress/generics/GEq/GEq1.stdout deleted file mode 100644 index a7f0546170..0000000000 --- a/testsuite/tests/ghc-regress/generics/GEq/GEq1.stdout +++ /dev/null @@ -1,4 +0,0 @@ -False -False -True -True diff --git a/testsuite/tests/ghc-regress/generics/GEq/GEq2.hs b/testsuite/tests/ghc-regress/generics/GEq/GEq2.hs deleted file mode 100644 index ac825aa71f..0000000000 --- a/testsuite/tests/ghc-regress/generics/GEq/GEq2.hs +++ /dev/null @@ -1,78 +0,0 @@ -{-# LANGUAGE TypeOperators, DefaultSignatures, FlexibleInstances, DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} - -module Main where - -import GHC.Generics hiding (C, D) - -class GEq' f where - geq' :: f a -> f a -> Bool - -instance GEq' U1 where - geq' _ _ = True - -instance (GEq c) => GEq' (K1 i c) where - geq' (K1 a) (K1 b) = geq a b - --- No instances for P or Rec because geq is only applicable to types of kind * - -instance (GEq' a) => GEq' (M1 i c a) where - geq' (M1 a) (M1 b) = geq' a b - -instance (GEq' a, GEq' b) => GEq' (a :+: b) where - geq' (L1 a) (L1 b) = geq' a b - geq' (R1 a) (R1 b) = geq' a b - geq' _ _ = False - -instance (GEq' a, GEq' b) => GEq' (a :*: b) where - geq' (a1 :*: b1) (a2 :*: b2) = geq' a1 a2 && geq' b1 b2 - - -class GEq a where - geq :: a -> a -> Bool - default geq :: (Generic a, GEq' (Rep a)) => a -> a -> Bool - geq x y = geq' (from x) (from y) - - --- Base types instances (ad-hoc) -instance GEq Char where geq = (==) -instance GEq Int where geq = (==) -instance GEq Float where geq = (==) -{- --- Generic instances -instance (GEq a) => GEq (Maybe a) -instance (GEq a) => GEq [a] --} - -data C = C0 | C1 - deriving Generic - -data D a = D0 | D1 { d11 :: a, d12 :: (D a) } - deriving Generic - -data (:**:) a b = a :**: b - deriving Generic - --- Example values -c0 = C0 -c1 = C1 - -d0 :: D Char -d0 = D0 -d1 = D1 'p' D0 - -p1 :: Int :**: Char -p1 = 3 :**: 'p' - --- Generic instances -instance GEq C -instance (GEq a) => GEq (D a) -instance (GEq a, GEq b) => GEq (a :**: b) - --- Tests -teq0 = geq c0 c1 -teq1 = geq d0 d1 -teq2 = geq d0 d0 -teq3 = geq p1 p1 - -main = mapM_ print [teq0, teq1, teq2, teq3] diff --git a/testsuite/tests/ghc-regress/generics/GEq/GEq2.stdout b/testsuite/tests/ghc-regress/generics/GEq/GEq2.stdout deleted file mode 100644 index a7f0546170..0000000000 --- a/testsuite/tests/ghc-regress/generics/GEq/GEq2.stdout +++ /dev/null @@ -1,4 +0,0 @@ -False -False -True -True diff --git a/testsuite/tests/ghc-regress/generics/GEq/Main.hs b/testsuite/tests/ghc-regress/generics/GEq/Main.hs deleted file mode 100644 index bc1fbd5e55..0000000000 --- a/testsuite/tests/ghc-regress/generics/GEq/Main.hs +++ /dev/null @@ -1,41 +0,0 @@ -{-# LANGUAGE TypeOperators, DeriveGeneric #-} - -module Main where - -import GHC.Generics hiding (C, D) -import GEq - --- We should be able to generate a generic representation for these types - -data C = C0 | C1 - deriving Generic - -data D a = D0 | D1 { d11 :: a, d12 :: (D a) } - deriving Generic - -data (:**:) a b = a :**: b - deriving Generic - --- Example values -c0 = C0 -c1 = C1 - -d0 :: D Char -d0 = D0 -d1 = D1 'p' D0 - -p1 :: Int :**: Char -p1 = 3 :**: 'p' - --- Generic instances -instance GEq C -instance (GEq a) => GEq (D a) -instance (GEq a, GEq b) => GEq (a :**: b) - --- Tests -teq0 = geq c0 c1 -teq1 = geq d0 d1 -teq2 = geq d0 d0 -teq3 = geq p1 p1 - -main = mapM_ print [teq0, teq1, teq2, teq3] diff --git a/testsuite/tests/ghc-regress/generics/GEq/Makefile b/testsuite/tests/ghc-regress/generics/GEq/Makefile deleted file mode 100644 index 1c39d1c1fe..0000000000 --- a/testsuite/tests/ghc-regress/generics/GEq/Makefile +++ /dev/null @@ -1,3 +0,0 @@ -TOP=../../../.. -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/test.mk diff --git a/testsuite/tests/ghc-regress/generics/GEq/test.T b/testsuite/tests/ghc-regress/generics/GEq/test.T deleted file mode 100644 index 363cb48212..0000000000 --- a/testsuite/tests/ghc-regress/generics/GEq/test.T +++ /dev/null @@ -1,4 +0,0 @@ -setTestOpts(only_compiler_types(['ghc'])) - -test('GEq1', normal, multimod_compile_and_run, ['Main', '']) -test('GEq2', normal, multimod_compile_and_run, ['GEq2', ''])
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/generics/GShow/GShow.hs b/testsuite/tests/ghc-regress/generics/GShow/GShow.hs deleted file mode 100644 index 3c8f2591ef..0000000000 --- a/testsuite/tests/ghc-regress/generics/GShow/GShow.hs +++ /dev/null @@ -1,124 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE IncoherentInstances #-} -- :-/ -{-# LANGUAGE DefaultSignatures #-} - -module GShow ( - -- * Generic show class - GShow(..) - ) where - - -import GHC.Generics - --------------------------------------------------------------------------------- --- Generic show --------------------------------------------------------------------------------- - -data Type = Rec | Tup | Pref | Inf String - -class GShow' f where - gshowsPrec' :: Type -> Int -> f a -> ShowS - isNullary :: f a -> Bool - isNullary = error "generic show (isNullary): unnecessary case" - -instance GShow' U1 where - gshowsPrec' _ _ U1 = id - isNullary _ = True - -instance (GShow c) => GShow' (K1 i c) where - gshowsPrec' _ n (K1 a) = gshowsPrec n a - isNullary _ = False - --- No instances for P or Rec because gshow is only applicable to types of kind * - -instance (GShow' a, Constructor c) => GShow' (M1 C c a) where - gshowsPrec' _ n c@(M1 x) = - case (fixity, conIsTuple c) of - (Prefix,False) -> showParen (n > 10 && not (isNullary x)) - ( showString (conName c) - . if (isNullary x) then id else showChar ' ' - . showBraces t (gshowsPrec' t 10 x)) - (Prefix,True) -> showParen (n > 10) (showBraces t (gshowsPrec' t 10 x)) - (Infix _ m,_) -> showParen (n > m) (showBraces t (gshowsPrec' t m x)) - where fixity = conFixity c - t = if (conIsRecord c) then Rec else - if (conIsTuple c) then Tup else - case fixity of - Prefix -> Pref - Infix _ _ -> Inf (show (conName c)) - showBraces :: Type -> ShowS -> ShowS - showBraces Rec p = showChar '{' . p . showChar '}' - showBraces Tup p = showChar '(' . p . showChar ')' - showBraces Pref p = p - showBraces (Inf _) p = p - conIsTuple c = case conName c of - ('(':',':_) -> True - otherwise -> False - - isNullary (M1 x) = isNullary x - -instance (Selector s, GShow' a) => GShow' (M1 S s a) where - gshowsPrec' t n s@(M1 x) | selName s == "" = showParen (n > 10) - (gshowsPrec' t n x) - | otherwise = showString (selName s) - . showString " = " - . gshowsPrec' t 0 x - isNullary (M1 x) = isNullary x - -instance (GShow' a) => GShow' (M1 D d a) where - gshowsPrec' t n (M1 x) = gshowsPrec' t n x - -instance (GShow' a, GShow' b) => GShow' (a :+: b) where - gshowsPrec' t n (L1 x) = gshowsPrec' t n x - gshowsPrec' t n (R1 x) = gshowsPrec' t n x - -instance (GShow' a, GShow' b) => GShow' (a :*: b) where - gshowsPrec' t@Rec n (a :*: b) = - gshowsPrec' t n a . showString ", " . gshowsPrec' t n b - gshowsPrec' t@(Inf s) n (a :*: b) = - gshowsPrec' t n a . showString s . gshowsPrec' t n b - gshowsPrec' t@Tup n (a :*: b) = - gshowsPrec' t n a . showChar ',' . gshowsPrec' t n b - gshowsPrec' t@Pref n (a :*: b) = - gshowsPrec' t (n+1) a . showChar ' ' . gshowsPrec' t (n+1) b - - -- If we have a product then it is not a nullary constructor - isNullary _ = False - - -class GShow a where - gshowsPrec :: Int -> a -> ShowS - default gshowsPrec :: (Generic a, GShow' (Rep a)) => Int -> a -> ShowS - gshowsPrec n = gshowsPrec' Pref n . from - - gshows :: a -> ShowS - gshows = gshowsPrec 0 - - gshow :: a -> String - gshow x = gshows x "" - - --- Base types instances -instance GShow Char where gshowsPrec = showsPrec -instance GShow Int where gshowsPrec = showsPrec -instance GShow Float where gshowsPrec = showsPrec -instance GShow String where gshowsPrec = showsPrec -instance GShow Bool where gshowsPrec = showsPrec - -intersperse :: a -> [a] -> [a] -intersperse _ [] = [] -intersperse _ [h] = [h] -intersperse x (h:t) = h : x : (intersperse x t) - -instance (GShow a) => GShow [a] where - gshowsPrec _ l = showChar '[' - . foldr (.) id - (intersperse (showChar ',') (map (gshowsPrec 0) l)) - . showChar ']' - -instance (GShow a) => GShow (Maybe a) -instance (GShow a, GShow b) => GShow (a,b) diff --git a/testsuite/tests/ghc-regress/generics/GShow/GShow1.stdout b/testsuite/tests/ghc-regress/generics/GShow/GShow1.stdout deleted file mode 100644 index 6109e446a5..0000000000 --- a/testsuite/tests/ghc-regress/generics/GShow/GShow1.stdout +++ /dev/null @@ -1,3 +0,0 @@ -D0 -D1 {d11 = Just 'p', d12 = D0} -D1 {d11 = (3,0.14), d12 = D0} diff --git a/testsuite/tests/ghc-regress/generics/GShow/Main.hs b/testsuite/tests/ghc-regress/generics/GShow/Main.hs deleted file mode 100644 index 81768ed647..0000000000 --- a/testsuite/tests/ghc-regress/generics/GShow/Main.hs +++ /dev/null @@ -1,23 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} - -module Main where - -import GHC.Generics hiding (C, D) -import GShow - --- We should be able to generate a generic representation for these types -data D a = D0 | D1 { d11 :: a, d12 :: (D a) } deriving Generic - --- Example values -d0 :: D Char -d0 = D0 -d1 = D1 (Just 'p') D0 - -d2 :: D (Int,Float) -d2 = D1 (3,0.14) D0 - --- Generic instances -instance (GShow a) => GShow (D a) - --- Tests -main = mapM_ putStrLn [gshow d0, gshow d1, gshow d2] diff --git a/testsuite/tests/ghc-regress/generics/GShow/Makefile b/testsuite/tests/ghc-regress/generics/GShow/Makefile deleted file mode 100644 index 1c39d1c1fe..0000000000 --- a/testsuite/tests/ghc-regress/generics/GShow/Makefile +++ /dev/null @@ -1,3 +0,0 @@ -TOP=../../../.. -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/test.mk diff --git a/testsuite/tests/ghc-regress/generics/GShow/test.T b/testsuite/tests/ghc-regress/generics/GShow/test.T deleted file mode 100644 index 68770ba884..0000000000 --- a/testsuite/tests/ghc-regress/generics/GShow/test.T +++ /dev/null @@ -1,3 +0,0 @@ -setTestOpts(only_compiler_types(['ghc'])) - -test('GShow1', normal, multimod_compile_and_run, ['Main', ''])
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/generics/GenCanDoRep0.hs b/testsuite/tests/ghc-regress/generics/GenCanDoRep0.hs deleted file mode 100644 index a86416b052..0000000000 --- a/testsuite/tests/ghc-regress/generics/GenCanDoRep0.hs +++ /dev/null @@ -1,23 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TypeOperators #-} - -module CanDoRep0 where - -import GHC.Generics (Generic) - - --- We should be able to generate a generic representation for these types -data A - deriving Generic - -data B a - deriving Generic - -data C = C0 | C1 - deriving Generic - -data D a = D0 | D1 { d11 :: a, d12 :: (D a) } - deriving Generic - -data (:*:) a b = a :*: b - deriving Generic diff --git a/testsuite/tests/ghc-regress/generics/GenCannotDoRep0.hs b/testsuite/tests/ghc-regress/generics/GenCannotDoRep0.hs deleted file mode 100644 index 5b4f93f94f..0000000000 --- a/testsuite/tests/ghc-regress/generics/GenCannotDoRep0.hs +++ /dev/null @@ -1,9 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE ExistentialQuantification #-} - -module CannotDoRep0 where - -import GHC.Generics - --- We do not support existential quantification -data Dynamic = forall a. Dynamic a deriving Generic diff --git a/testsuite/tests/ghc-regress/generics/GenCannotDoRep0.stderr b/testsuite/tests/ghc-regress/generics/GenCannotDoRep0.stderr deleted file mode 100644 index b5d2f01381..0000000000 --- a/testsuite/tests/ghc-regress/generics/GenCannotDoRep0.stderr +++ /dev/null @@ -1,5 +0,0 @@ - -GenCannotDoRep0.hs:9:45: - Can't make a derived instance of `Generic Dynamic': - Dynamic must be a vanilla data constructor - In the data type declaration for `Dynamic' diff --git a/testsuite/tests/ghc-regress/generics/GenCannotDoRep1.hs b/testsuite/tests/ghc-regress/generics/GenCannotDoRep1.hs deleted file mode 100644 index 98ad108dbf..0000000000 --- a/testsuite/tests/ghc-regress/generics/GenCannotDoRep1.hs +++ /dev/null @@ -1,8 +0,0 @@ -{-# LANGUAGE DeriveGeneric, DatatypeContexts #-} - -module CannotDoRep1 where - -import GHC.Generics - --- We do not support datatypes with context -data (Show a) => Context a = Context a deriving Generic diff --git a/testsuite/tests/ghc-regress/generics/GenCannotDoRep1.stderr b/testsuite/tests/ghc-regress/generics/GenCannotDoRep1.stderr deleted file mode 100644 index 477a2955ce..0000000000 --- a/testsuite/tests/ghc-regress/generics/GenCannotDoRep1.stderr +++ /dev/null @@ -1,8 +0,0 @@ - -GenCannotDoRep1.hs:1:29: - Warning: -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language. - -GenCannotDoRep1.hs:8:49: - Can't make a derived instance of `Generic (Context a)': - Context must not have a datatype context - In the data type declaration for `Context' diff --git a/testsuite/tests/ghc-regress/generics/GenCannotDoRep2.hs b/testsuite/tests/ghc-regress/generics/GenCannotDoRep2.hs deleted file mode 100644 index ad816f4ce4..0000000000 --- a/testsuite/tests/ghc-regress/generics/GenCannotDoRep2.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE GADTs #-} - -module CannotDoRep2 where - -import GHC.Generics - --- We do not support GADTs -data Term a where - Int :: Term Int - -deriving instance Generic (Term a) diff --git a/testsuite/tests/ghc-regress/generics/GenCannotDoRep2.stderr b/testsuite/tests/ghc-regress/generics/GenCannotDoRep2.stderr deleted file mode 100644 index 35caf2c3b4..0000000000 --- a/testsuite/tests/ghc-regress/generics/GenCannotDoRep2.stderr +++ /dev/null @@ -1,5 +0,0 @@ - -GenCannotDoRep2.hs:13:1: - Can't make a derived instance of `Generic (Term a)': - Int must be a vanilla data constructor - In the stand-alone deriving instance for `Generic (Term a)' diff --git a/testsuite/tests/ghc-regress/generics/GenDeprecated.stderr b/testsuite/tests/ghc-regress/generics/GenDeprecated.stderr deleted file mode 100644 index d07c35d3a3..0000000000 --- a/testsuite/tests/ghc-regress/generics/GenDeprecated.stderr +++ /dev/null @@ -1,3 +0,0 @@ - -GenDeprecated.hs:1:14: - Warning: -XGenerics is deprecated: it does nothing; look into -XDefaultSignatures and -XDeriveGeneric for generic programming support. diff --git a/testsuite/tests/ghc-regress/generics/GenShouldFail0.hs b/testsuite/tests/ghc-regress/generics/GenShouldFail0.hs deleted file mode 100644 index cc1ef6ff42..0000000000 --- a/testsuite/tests/ghc-regress/generics/GenShouldFail0.hs +++ /dev/null @@ -1,11 +0,0 @@ -{-# LANGUAGE StandaloneDeriving #-} - -module ShouldFail0 where - -import GHC.Generics (Generic) - -data X = X - -deriving instance Generic X - --- Should fail (no XDeriveGeneric) diff --git a/testsuite/tests/ghc-regress/generics/GenShouldFail0.stderr b/testsuite/tests/ghc-regress/generics/GenShouldFail0.stderr deleted file mode 100644 index 3685e67784..0000000000 --- a/testsuite/tests/ghc-regress/generics/GenShouldFail0.stderr +++ /dev/null @@ -1,5 +0,0 @@ - -GenShouldFail0.hs:9:1: - Can't make a derived instance of `Generic X': - You need -XDeriveGeneric to derive an instance for this class - In the stand-alone deriving instance for `Generic X' diff --git a/testsuite/tests/ghc-regress/generics/Makefile b/testsuite/tests/ghc-regress/generics/Makefile deleted file mode 100644 index 9101fbd40a..0000000000 --- a/testsuite/tests/ghc-regress/generics/Makefile +++ /dev/null @@ -1,3 +0,0 @@ -TOP=../../.. -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/test.mk diff --git a/testsuite/tests/ghc-regress/generics/Uniplate/GUniplate.hs b/testsuite/tests/ghc-regress/generics/Uniplate/GUniplate.hs deleted file mode 100644 index 76f387d636..0000000000 --- a/testsuite/tests/ghc-regress/generics/Uniplate/GUniplate.hs +++ /dev/null @@ -1,53 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE IncoherentInstances #-} -- necessary, unfortunately - -module GUniplate where - -import GHC.Generics - --------------------------------------------------------------------------------- --- Generic Uniplate --------------------------------------------------------------------------------- - -class Uniplate' f b where - children' :: f a -> [b] - -instance Uniplate' U1 a where - children' U1 = [] - -instance Uniplate' (K1 i a) a where - children' (K1 a) = [a] - -instance Uniplate' (K1 i a) b where - children' (K1 _) = [] - -instance (Uniplate' f b) => Uniplate' (M1 i c f) b where - children' (M1 a) = children' a - -instance (Uniplate' f b, Uniplate' g b) => Uniplate' (f :+: g) b where - children' (L1 a) = children' a - children' (R1 a) = children' a - -instance (Uniplate' f b, Uniplate' g b) => Uniplate' (f :*: g) b where - children' (a :*: b) = children' a ++ children' b - - -class Uniplate a where - children :: a -> [a] - default children :: (Generic a, Uniplate' (Rep a) a) => a -> [a] - children = children' . from - - --- Base types instances -instance Uniplate Char where children _ = [] -instance Uniplate Int where children _ = [] -instance Uniplate Float where children _ = [] - -instance Uniplate [a] where - children [] = [] - children (_:t) = [t] diff --git a/testsuite/tests/ghc-regress/generics/Uniplate/GUniplate1.stdout b/testsuite/tests/ghc-regress/generics/Uniplate/GUniplate1.stdout deleted file mode 100644 index f560e40162..0000000000 --- a/testsuite/tests/ghc-regress/generics/Uniplate/GUniplate1.stdout +++ /dev/null @@ -1 +0,0 @@ -("",[],[Leaf,Leaf]) diff --git a/testsuite/tests/ghc-regress/generics/Uniplate/Main.hs b/testsuite/tests/ghc-regress/generics/Uniplate/Main.hs deleted file mode 100644 index 95d84244fa..0000000000 --- a/testsuite/tests/ghc-regress/generics/Uniplate/Main.hs +++ /dev/null @@ -1,20 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} - -module Main where - -import GHC.Generics -import GUniplate - - -data Tree = Leaf | Node Int Tree Tree deriving (Show, Generic) -data Pair a b = Pair a b deriving (Show, Generic) - -instance Uniplate Tree -instance Uniplate (Pair a b) - --- Tests -t1 = children ('p') -t2 = children (Pair "abc" (Pair "abc" 2)) -t3 = children (Node 2 Leaf Leaf) - -main = print (t1, t2, t3) diff --git a/testsuite/tests/ghc-regress/generics/Uniplate/Makefile b/testsuite/tests/ghc-regress/generics/Uniplate/Makefile deleted file mode 100644 index 1c39d1c1fe..0000000000 --- a/testsuite/tests/ghc-regress/generics/Uniplate/Makefile +++ /dev/null @@ -1,3 +0,0 @@ -TOP=../../../.. -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/test.mk diff --git a/testsuite/tests/ghc-regress/generics/Uniplate/test.T b/testsuite/tests/ghc-regress/generics/Uniplate/test.T deleted file mode 100644 index a1e610726e..0000000000 --- a/testsuite/tests/ghc-regress/generics/Uniplate/test.T +++ /dev/null @@ -1,3 +0,0 @@ -setTestOpts(only_compiler_types(['ghc'])) - -test('GUniplate1', normal, multimod_compile_and_run, ['Main', ''])
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/generics/all.T b/testsuite/tests/ghc-regress/generics/all.T deleted file mode 100644 index 5ef616c811..0000000000 --- a/testsuite/tests/ghc-regress/generics/all.T +++ /dev/null @@ -1,8 +0,0 @@ -setTestOpts(only_compiler_types(['ghc'])) - -test('GenCanDoRep0', normal, compile, ['']) - -test('GenShouldFail0', normal, compile_fail, ['']) -test('GenCannotDoRep0', normal, compile_fail, ['']) -test('GenCannotDoRep1', normal, compile_fail, ['']) -test('GenCannotDoRep2', normal, compile_fail, ['']) |