Move tests from tests/ghc-regress/* to just tests/*

7 files changed, 178 insertions, 0 deletions

diff --git a/testsuite/tests/generics/GEq/GEq.hs b/testsuite/tests/generics/GEq/GEq.hs
new file mode 100644
index 0000000000..54caad34e5
--- /dev/null
+++ b/testsuite/tests/generics/GEq/GEq.hs
@@ -0,0 +1,44 @@
+{-# 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/generics/GEq/GEq1.stdout b/testsuite/tests/generics/GEq/GEq1.stdout
new file mode 100644
index 0000000000..a7f0546170
--- /dev/null
+++ b/testsuite/tests/generics/GEq/GEq1.stdout
@@ -0,0 +1,4 @@
+False
+False
+True
+True
diff --git a/testsuite/tests/generics/GEq/GEq2.hs b/testsuite/tests/generics/GEq/GEq2.hs
new file mode 100644
index 0000000000..ac825aa71f
--- /dev/null
+++ b/testsuite/tests/generics/GEq/GEq2.hs
@@ -0,0 +1,78 @@
+{-# 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/generics/GEq/GEq2.stdout b/testsuite/tests/generics/GEq/GEq2.stdout
new file mode 100644
index 0000000000..a7f0546170
--- /dev/null
+++ b/testsuite/tests/generics/GEq/GEq2.stdout
@@ -0,0 +1,4 @@
+False
+False
+True
+True
diff --git a/testsuite/tests/generics/GEq/Main.hs b/testsuite/tests/generics/GEq/Main.hs
new file mode 100644
index 0000000000..bc1fbd5e55
--- /dev/null
+++ b/testsuite/tests/generics/GEq/Main.hs
@@ -0,0 +1,41 @@
+{-# 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/generics/GEq/Makefile b/testsuite/tests/generics/GEq/Makefile
new file mode 100644
index 0000000000..9101fbd40a
--- /dev/null
+++ b/testsuite/tests/generics/GEq/Makefile
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/generics/GEq/test.T b/testsuite/tests/generics/GEq/test.T
new file mode 100644
index 0000000000..363cb48212
--- /dev/null
+++ b/testsuite/tests/generics/GEq/test.T
@@ -0,0 +1,4 @@
+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