[commit: template-haskell] master: Fix the data constructors for tuples etc that dataToExpQ builds (fdeb047)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/template-haskell

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/fdeb047bff236b7132c619e7e6ba1852166f0959

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

commit fdeb047bff236b7132c619e7e6ba1852166f0959
Author: Ian Lynagh <igloo at earth.li>
Date:   Wed Feb 8 16:11:16 2012 +0000

    Fix the data constructors for tuples etc that dataToExpQ builds
    
    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 |    6 +++---
 tests/Makefile               |    7 +++++++
 tests/all.T                  |    1 +
 tests/dataToExpQUnit.hs      |   15 +++++++++++++++
 tests/dataToExpQUnit.stderr  |    1 +
 5 files changed, 27 insertions(+), 3 deletions(-)

diff --git a/Language/Haskell/TH/Quote.hs b/Language/Haskell/TH/Quote.hs
index 357bf8f..3a13fe1 100644
--- a/Language/Haskell/TH/Quote.hs
+++ b/Language/Haskell/TH/Quote.hs
@@ -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
index 0000000..6a0abcf
--- /dev/null
+++ b/tests/Makefile
@@ -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
index 0000000..4179eb3
--- /dev/null
+++ b/tests/all.T
@@ -0,0 +1 @@
+test('dataToExpQUnit', normal, compile, ['-v0'])
diff --git a/tests/dataToExpQUnit.hs b/tests/dataToExpQUnit.hs
new file mode 100644
index 0000000..1fac187
--- /dev/null
+++ b/tests/dataToExpQUnit.hs
@@ -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
index 0000000..0ca9514
--- /dev/null
+++ b/tests/dataToExpQUnit.stderr
@@ -0,0 +1 @@
+True