[commit: testsuite] overlapping-tyfams: More tests for closed type families, including interactions with TH. (4b53b18)

Richard Eisenberg eir at cis.upenn.edu
Fri Jun 21 15:17:13 CEST 2013


Repository : ssh://darcs.haskell.org//srv/darcs/testsuite

On branch  : overlapping-tyfams

https://github.com/ghc/testsuite/commit/4b53b183bc943e46793edd0bd37bfd9bab6b8941

>---------------------------------------------------------------

commit 4b53b183bc943e46793edd0bd37bfd9bab6b8941
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Thu Jun 20 16:33:30 2013 +0100

    More tests for closed type families, including interactions with TH.

>---------------------------------------------------------------

 tests/th/ClosedFam1.hs          |   13 +++++++++++++
 tests/th/ClosedFam1.stderr      |    6 ++++++
 tests/th/ClosedFam2.hs          |   22 ++++++++++++++++++++++
 tests/th/TH_TyInstWhere1.hs     |    4 +---
 tests/th/TH_TyInstWhere2.hs     |    4 +---
 tests/th/TH_TyInstWhere3.hs     |   18 ------------------
 tests/th/TH_TyInstWhere3.stderr |    3 ---
 tests/th/TH_TyInstWhere4.hs     |   20 --------------------
 tests/th/TH_TyInstWhere4.stderr |   16 ----------------
 tests/th/all.T                  |    5 +++--
 10 files changed, 46 insertions(+), 65 deletions(-)

diff --git a/tests/th/ClosedFam1.hs b/tests/th/ClosedFam1.hs
new file mode 100644
index 0000000..262e9a1
--- /dev/null
+++ b/tests/th/ClosedFam1.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE TemplateHaskell, TypeFamilies, PolyKinds, DataKinds #-}
+
+module ClosedFam1 where
+
+import Language.Haskell.TH
+
+$(do { decl <- [d| type family Foo a (b :: k) where
+                     Foo Int Bool = Int
+                     Foo a Maybe = Bool
+                     Foo b (x :: Bool) = Char |]
+     ; reportWarning (pprint decl)
+     ; return [] })
+
diff --git a/tests/th/ClosedFam1.stderr b/tests/th/ClosedFam1.stderr
new file mode 100644
index 0000000..d9827d8
--- /dev/null
+++ b/tests/th/ClosedFam1.stderr
@@ -0,0 +1,6 @@
+
+ClosedFam1.hs:7:3: Warning:
+    type family Foo_0 a_1 (b_2 :: k_3) where
+    Foo_0 GHC.Types.Int GHC.Types.Bool = GHC.Types.Int
+    Foo_0 a_4 Data.Maybe.Maybe = GHC.Types.Bool
+    Foo_0 b_5 (x_6 :: GHC.Types.Bool) = GHC.Types.Char
diff --git a/tests/th/ClosedFam2.hs b/tests/th/ClosedFam2.hs
new file mode 100644
index 0000000..cd2dc2d
--- /dev/null
+++ b/tests/th/ClosedFam2.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE TemplateHaskell, TypeFamilies, PolyKinds #-}
+
+module ClosedFam2 where
+
+import Language.Haskell.TH
+
+$( return [ ClosedTypeFamilyD (mkName "Equals")
+                              [ KindedTV (mkName "a") (VarT (mkName "k"))
+                              , KindedTV (mkName "b") (VarT (mkName "k")) ]
+                              Nothing
+                              [ TySynEqn [ (VarT (mkName "a"))
+                                         , (VarT (mkName "a")) ]
+                                         (ConT (mkName "Int"))
+                              , TySynEqn [ (VarT (mkName "a"))
+                                         , (VarT (mkName "b")) ]
+                                         (ConT (mkName "Bool")) ] ])
+
+a :: Equals b b
+a = (5 :: Int)
+
+b :: Equals Int Bool
+b = False
diff --git a/tests/th/TH_TyInstWhere1.hs b/tests/th/TH_TyInstWhere1.hs
index 8352d4b..d8c07d7 100644
--- a/tests/th/TH_TyInstWhere1.hs
+++ b/tests/th/TH_TyInstWhere1.hs
@@ -2,9 +2,7 @@
 
 module TH_TyInstWhere1 where
 
-type family F (a :: k) (b :: k) :: Bool
-
-$([d| type instance where
+$([d| type family F (a :: k) (b :: k) :: Bool where
         F a a = True
         F a b = False |])
 
diff --git a/tests/th/TH_TyInstWhere2.hs b/tests/th/TH_TyInstWhere2.hs
index ec27ced..47fedad 100644
--- a/tests/th/TH_TyInstWhere2.hs
+++ b/tests/th/TH_TyInstWhere2.hs
@@ -4,9 +4,7 @@ module TH_TyInstWhere2 where
 
 import Language.Haskell.TH
 
-type family F (a :: k) (b :: k) :: Bool
-
-$( do { decs <- [d| type instance where
+$( do { decs <- [d| type family F (a :: k) (b :: k) :: Bool where
                       F a a = True
                       F a b = False |]
       ; reportWarning (pprint decs)
diff --git a/tests/th/TH_TyInstWhere3.hs b/tests/th/TH_TyInstWhere3.hs
deleted file mode 100644
index 54d76f5..0000000
--- a/tests/th/TH_TyInstWhere3.hs
+++ /dev/null
@@ -1,18 +0,0 @@
-{-# LANGUAGE PolyKinds, DataKinds, TemplateHaskell, TypeFamilies #-}
-
-module TH_TyInstWhere3 where
-
-import Language.Haskell.TH
-
-type family F a
-
-$( do { decs <- [d| type instance where
-                      F Int = Int |]
-      ; reportWarning (pprint decs)
-      ; return decs })
-
-type instance F a = a 
-
--- When this test was written, TH considered all singleton type family instance
--- as unbranched. Thus, even though the two instances above would not play nicely
--- without TH, they should be fine with TH.
diff --git a/tests/th/TH_TyInstWhere3.stderr b/tests/th/TH_TyInstWhere3.stderr
deleted file mode 100644
index eaebfec..0000000
--- a/tests/th/TH_TyInstWhere3.stderr
+++ /dev/null
@@ -1,3 +0,0 @@
-
-TH_TyInstWhere3.hs:9:4: Warning:
-    type instance TH_TyInstWhere3.F GHC.Types.Int = GHC.Types.Int
diff --git a/tests/th/TH_TyInstWhere4.hs b/tests/th/TH_TyInstWhere4.hs
deleted file mode 100644
index 86415ff..0000000
--- a/tests/th/TH_TyInstWhere4.hs
+++ /dev/null
@@ -1,20 +0,0 @@
-{-# LANGUAGE PolyKinds, DataKinds, TemplateHaskell, TypeFamilies #-}
-
-module TH_TyInstWhere4 where
-
-import Language.Haskell.TH
-
-type family F a b :: Bool
-type instance where
-  F a a = True
-  F a b = False
-
-$( do { info1 <- reify ''F
-      ; reportWarning (pprint info1)
-      ; info2 <- reifyInstances ''F [ConT ''Int, ConT ''Int]
-      ; reportWarning (pprint info2)
-      ; info3 <- reifyInstances ''F [ConT ''Int, ConT ''Bool]
-      ; reportWarning (pprint info3)
-      ; return [] })
-
-
diff --git a/tests/th/TH_TyInstWhere4.stderr b/tests/th/TH_TyInstWhere4.stderr
deleted file mode 100644
index 70dfe85..0000000
--- a/tests/th/TH_TyInstWhere4.stderr
+++ /dev/null
@@ -1,16 +0,0 @@
-
-TH_TyInstWhere4.hs:12:4: Warning:
-    type family TH_TyInstWhere4.F a_0 b_1 :: * -> * -> GHC.Types.Bool
-type instance where
-    TH_TyInstWhere4.F a_2 a_2 = GHC.Types.True
-    TH_TyInstWhere4.F a_3 b_4 = GHC.Types.False
-
-TH_TyInstWhere4.hs:12:4: Warning:
-    type instance where
-    TH_TyInstWhere4.F a_0 a_0 = GHC.Types.True
-    TH_TyInstWhere4.F a_1 b_2 = GHC.Types.False
-
-TH_TyInstWhere4.hs:12:4: Warning:
-    type instance where
-    TH_TyInstWhere4.F a_0 a_0 = GHC.Types.True
-    TH_TyInstWhere4.F a_1 b_2 = GHC.Types.False
diff --git a/tests/th/all.T b/tests/th/all.T
index ad1c4e9..c6407c4 100644
--- a/tests/th/all.T
+++ b/tests/th/all.T
@@ -261,8 +261,6 @@ test('T7276a', combined_output, ghci_script, ['T7276a.script'])
 
 test('TH_TyInstWhere1', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
 test('TH_TyInstWhere2', normal, compile, ['-v0'])
-test('TH_TyInstWhere3', normal, compile, ['-v0'])
-test('TH_TyInstWhere4', normal, compile, ['-v0'])
 
 test('T7445', extra_clean(['T7445a.hi', 'T7445a.o']),
 	      run_command,
@@ -275,3 +273,6 @@ test('T2222', normal, compile, ['-v0'])
 test('T1849', normal, ghci_script, ['T1849.script'])
 test('T7681', normal, compile, ['-v0'])
 test('T7910', normal, compile_and_run, ['-v0'])
+
+test('ClosedFam1', normal, compile, ['-dsuppress-uniques -v0'])
+test('ClosedFam2', normal, compile, ['-v0'])
\ No newline at end of file





More information about the ghc-commits mailing list