Fix the data constructors for tuples etc that dataToExpQ builds
authorIan Lynagh <igloo@earth.li>
Wed, 8 Feb 2012 16:11:16 +0000 (16:11 +0000)
committerIan Lynagh <igloo@earth.li>
Wed, 8 Feb 2012 16:16:39 +0000 (16:16 +0000)
Conal Elliott reported that dataToExpQ built a different constructor
for () than [| () |]. This patch fixes that, and adds a regression test.

Language/Haskell/TH/Quote.hs
tests/Makefile [new file with mode: 0644]
tests/all.T [new file with mode: 0644]
tests/dataToExpQUnit.hs [new file with mode: 0644]
tests/dataToExpQUnit.stderr [new file with mode: 0644]

index 357bf8f..3a13fe1 100644 (file)
@@ -31,9 +31,9 @@ dataToQa mkCon mkLit appCon antiQ t =
                 conName :: Name
                 conName =
                     case showConstr constr of
-                      "(:)"       -> Name (mkOccName ":") NameS
-                      con@"[]"    -> Name (mkOccName con) NameS
-                      con@('(':_) -> Name (mkOccName con) NameS
+                      "(:)"       -> Name (mkOccName ":") (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Types"))
+                      con@"[]"    -> Name (mkOccName con) (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Types"))
+                      con@('(':_) -> Name (mkOccName con) (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Tuple"))
                       con         -> mkNameG_d (tyConPackage tycon)
                                                (tyConModule tycon)
                                                con
diff --git a/tests/Makefile b/tests/Makefile
new file mode 100644 (file)
index 0000000..6a0abcf
--- /dev/null
@@ -0,0 +1,7 @@
+# This Makefile runs the tests using GHC's testsuite framework.  It
+# assumes the package is part of a GHC build tree with the testsuite
+# installed in ../../../testsuite.
+
+TOP=../../../testsuite
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/tests/all.T b/tests/all.T
new file mode 100644 (file)
index 0000000..4179eb3
--- /dev/null
@@ -0,0 +1 @@
+test('dataToExpQUnit', normal, compile, ['-v0'])
diff --git a/tests/dataToExpQUnit.hs b/tests/dataToExpQUnit.hs
new file mode 100644 (file)
index 0000000..1fac187
--- /dev/null
@@ -0,0 +1,15 @@
+
+{-# LANGUAGE TemplateHaskell #-}
+
+module Foo where
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Quote
+import System.IO
+
+$( do u1 <- runQ (dataToExpQ (const Nothing) ())
+      u2 <- runQ [| () |]
+      runIO $ print (u1 == u2)
+      runIO $ hFlush stdout
+      return []
+ )
diff --git a/tests/dataToExpQUnit.stderr b/tests/dataToExpQUnit.stderr
new file mode 100644 (file)
index 0000000..0ca9514
--- /dev/null
@@ -0,0 +1 @@
+True